1 (*

     2  * Hedgewars, a worms-like game

     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

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

     6  *

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

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

     9  * with the Software without restriction, including without limitation the

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

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

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

    13  *

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

    15  *    this list of conditions and the following disclaimer.

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

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

    18  *    and/or other materials provided with the distribution.

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

    20  *    derived from this software without specific prior written permission.

    21  *

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

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

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

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

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

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

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

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

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

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uStore;

    35 interface

    36 uses uConsts, uTeams, SDLh;

    37 {$INCLUDE options.inc}

    38 

    39 type PRangeArray = ^TRangeArray;

    40      TRangeArray = array[byte] of record

    41                                   Left, Right: integer;

    42                                   end;

    43 

    44 procedure StoreInit;

    45 procedure StoreLoad;

    46 procedure StoreRelease;

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

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

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

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

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

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

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

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

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

    56 procedure RenderHealth(var Hedgehog: THedgehog);

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

    58 procedure AddProgress;

    59 function  LoadImage(filename: string): PSDL_Surface;

    60 

    61 var PixelFormat: PSDL_PixelFormat;

    62  SDLPrimSurface: PSDL_Surface;

    63 

    64 implementation

    65 uses uMisc, uIO, uConsole, uLand;

    66 

    67 var StoreSurface,

    68      TempSurface,

    69        HHSurface: PSDL_Surface;

    70 

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

    72 var ty, tx: integer;

    73     p: integer;

    74 begin

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

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

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

    78 

    79 if SDL_MustLock(LandSurface) then

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

    81 

    82 p:= Longword(LandSurface.pixels);

    83 case LandSurface.format.BytesPerPixel of

    84      1: ;// not supported

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

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

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

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

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

    90                 begin

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

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

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

    94                 end;

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

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

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

    98      end;

    99 

   100 inc(Radius, 4);

   101 

   102 case LandSurface.format.BytesPerPixel of

   103      1: ;// not supported

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

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

   106                if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then

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

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

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

   110                 if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)

   111                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)

   112                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)

   113                 then begin

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

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

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

   117                 end;

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

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

   120                 if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then

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

   122      end;

   123 

   124 if SDL_MustLock(LandSurface) then

   125    SDL_UnlockSurface(LandSurface);

   126 

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

   128 end;

   129 

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

   131 var tx, ty, i, p: integer;

   132 begin

   133 if SDL_MustLock(LandSurface) then

   134    SDL_LockSurface(LandSurface);

   135 

   136 p:= Longword(LandSurface.pixels);

   137 for i:= 0 to Pred(Count) do

   138     begin

   139     case LandSurface.format.BytesPerPixel of

   140      1: ;

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

   142             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

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

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

   145             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

   146                 begin

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

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

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

   150                 end;

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

   152             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

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

   154      end;

   155     inc(y, dY)

   156     end;

   157 

   158 inc(Radius, 4);

   159 dec(y, Count*dY);

   160 

   161 for i:= 0 to Pred(Count) do

   162     begin

   163     case LandSurface.format.BytesPerPixel of

   164      1: ;

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

   166             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

   167                if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then

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

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

   170             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

   171                 if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)

   172                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)

   173                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)

   174                 then begin

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

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

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

   178                 end;

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

   180             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

   181                 if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then

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

   183      end;

   184     inc(y, dY)

   185     end;

   186 

   187 if SDL_MustLock(LandSurface) then

   188    SDL_UnlockSurface(LandSurface);

   189 end;

   190 

   191 procedure StoreInit;

   192 begin

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

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

   195 

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

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

   198 

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

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

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

   202 end;

   203 

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

   205 var tmpsurf: PSDL_Surface;

   206     rr: TSDL_Rect;

   207 begin

   208   tmpsurf:= LoadImage(Filename);

   209   rr.x:= X;

   210   rr.y:= Y;

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

   212   SDL_FreeSurface(tmpsurf);

   213 end;

   214 

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

   216 var w, h: integer;

   217     tmpsurf: PSDL_Surface;

   218     clr: TSDL_Color;

   219 begin

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

   221 Result.x:= X;

   222 Result.y:= Y;

   223 Result.w:= w + 6;

   224 Result.h:= h + 6;

   225 SDL_FillRect(Surface, @Result, 0);

   226 Result.w:= 1;

   227 Result.y:= Y + 1;

   228 Result.h:= h + 4;

   229 SDL_FillRect(Surface, @Result, cWhiteColor);

   230 Result.x:= X + w + 5;

   231 SDL_FillRect(Surface, @Result, cWhiteColor);

   232 Result.x:= X + 1;

   233 Result.w:= w + 4;

   234 Result.y:= Y;

   235 Result.h:= 1;

   236 SDL_FillRect(Surface, @Result, cWhiteColor);

   237 Result.y:= Y + h + 5;

   238 SDL_FillRect(Surface, @Result, cWhiteColor);

   239 Result.x:= X + 1;

   240 Result.y:= Y + 1;

   241 Result.h:= h + 4;

   242 SDL_FillRect(Surface, @Result, cColorNearBlack);

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

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

   245 Result.x:= X + 3;

   246 Result.y:= Y + 3;

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

   248 SDL_FreeSurface(tmpsurf);

   249 Result.x:= X;

   250 Result.y:= Y;

   251 Result.w:= w + 6;

   252 Result.h:= h + 6

   253 end;

   254 

   255 procedure StoreLoad;

   256 var i: TStuff;

   257     ii: TSprite;

   258     fi: THWFont;

   259     s: string;

   260     tmpsurf: PSDL_Surface;

   261 

   262     procedure WriteNames(Font: THWFont);

   263     var Team: PTeam;

   264         i: integer;

   265         r: TSDL_Rect;

   266     begin

   267     r.x:= 0;

   268     r.y:= 272;

   269     Team:= TeamsList;

   270     while Team<>nil do

   271       begin

   272       r.w:= 1968;

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

   274       Team.NameRect:= r;

   275       inc(r.y, r.h);

   276       for i:= 0 to 7 do

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

   278              begin

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

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

   281              inc(r.y, r.h)

   282              end;

   283       Team:= Team.Next

   284       end;

   285     end;

   286 

   287     procedure MakeCrossHairs;

   288     var Team: PTeam;

   289         r: TSDL_Rect;

   290         tmpsurf: PSDL_Surface;

   291         s: string;

   292         TransColor: Longword;

   293     begin

   294     r.x:= 0;

   295     r.y:= 256;

   296     r.w:= 16;

   297     r.h:= 16;

   298     s:= Pathz[ptGraphics] + cCHFileName;

   299     WriteToConsole(msgLoading + s + ' ');

   300     tmpsurf:= IMG_Load(PChar(s));

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

   302     WriteLnToConsole(msgOK);

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

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

   305 

   306     Team:= TeamsList;

   307     while Team<>nil do

   308       begin

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

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

   311       Team.CrossHairRect:= r;

   312       inc(r.x, 16);

   313       Team:= Team.Next

   314       end;

   315       

   316     SDL_FreeSurface(tmpsurf)

   317     end;

   318 

   319     procedure InitHealth;

   320     var p: PTeam;

   321         i, t: integer;

   322     begin

   323     p:= TeamsList;

   324     t:= 0;

   325     while p <> nil do

   326           begin

   327           for i:= 0 to cMaxHHIndex do

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

   329                  begin

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

   331                  RenderHealth(p.Hedgehogs[i]);

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

   333                  end;

   334           p:= p.Next

   335           end

   336     end;

   337 

   338     procedure LoadGraves;

   339     var p: PTeam;

   340         l: integer;

   341     begin

   342     p:= TeamsList;

   343     l:= 512;

   344     while p <> nil do

   345           begin

   346           dec(l, 32);

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

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

   349           p.GraveRect.x:= l;

   350           p.GraveRect.y:= 512;

   351           p.GraveRect.w:= 32;

   352           p.GraveRect.h:= 256;

   353           p:= p.Next

   354           end

   355     end;

   356 

   357     procedure GetSkyColor;

   358     var p: Longword;

   359     begin

   360     if SDL_MustLock(StoreSurface) then

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

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

   363     case StoreSurface.format.BytesPerPixel of

   364          1: cSkyColor:= PByte(p)^;

   365          2: cSkyColor:= PWord(p)^;

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

   367          4: cSkyColor:= PLongword(p)^;

   368          end;

   369     if SDL_MustLock(StoreSurface) then

   370        SDL_UnlockSurface(StoreSurface)

   371     end;

   372 

   373     procedure GetExplosionBorderColor;

   374     var f: textfile;

   375         c: integer;

   376     begin

   377     s:= Pathz[ptThemeCurrent] + cThemeCFGFilename;

   378     WriteToConsole(msgLoading + s + ' ');

   379     AssignFile(f, s);

   380     {$I-}

   381     Reset(f);

   382     Readln(f, s);

   383     Closefile(f);

   384     {$I+}

   385     TryDo(IOResult = 0, msgFailed, true);

   386     WriteLnToConsole(msgOK);

   387     val(s, cExplosionBorderColor, c);

   388     if cFullScreen then

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

   390                                                     (cExplosionBorderColor shr 8) and $FF,

   391                                                      cExplosionBorderColor and $FF)

   392     else

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

   394                                                            (cExplosionBorderColor shr 8) and $FF,

   395                                                             cExplosionBorderColor and $FF)

   396     end;

   397 

   398 begin

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

   400     with Fontz[fi] do

   401          begin

   402          s:= Pathz[ptFonts] + Name;

   403          WriteToConsole(msgLoading + s + ' ');

   404          Handle:= TTF_OpenFont(PChar(s), Height);

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

   406          WriteLnToConsole(msgOK)

   407          end;

   408 AddProgress;

   409 s:= Pathz[ptMapCurrent] + cLandFileName;

   410 WriteToConsole(msgLoading + s + ' ');         // загружаем текущее поле

   411 //tmpsurf:= IMG_Load(PChar(s));

   412 tmpsurf:= LandSurface;

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

   414 if cFullScreen then

   415    begin

   416    LandSurface:= SDL_DisplayFormat(tmpsurf);

   417    SDL_FreeSurface(tmpsurf);

   418    end else LandSurface:= tmpsurf;

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

   420 WriteLnToConsole(msgOK);

   421 

   422 GetExplosionBorderColor;

   423 

   424 AddProgress;

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

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

   427 

   428 AddProgress;

   429 WriteNames(fnt16);

   430 MakeCrosshairs;

   431 LoadGraves;

   432 

   433 GetSkyColor;

   434 

   435 AddProgress;

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

   437     with SpritesData[ii] do

   438          begin

   439          Surface:= LoadImage(Pathz[Path] + FileName);

   440          TryDo(SDL_SetColorKey(Surface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true)

   441          end;

   442 

   443 AddProgress;

   444 tmpsurf:= LoadImage(Pathz[ptGraphics] + cHHFileName);

   445 HHSurface:= SDL_DisplayFormat(tmpsurf);

   446 SDL_FreeSurface(tmpsurf);

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

   448 

   449 InitHealth;

   450 

   451 {$IFDEF DUMP}

   452 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);

   453 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);

   454 SDL_SaveBMP_RW(TempSurface, SDL_RWFromFile('TempSurface.bmp', 'wb'), 1);

   455 {$ENDIF}

   456 end;

   457 

   458 procedure DrawFromRect(X, Y: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);

   459 var rr: TSDL_Rect;

   460 begin

   461 rr.x:= X;

   462 rr.y:= Y;

   463 rr.w:= r.w;

   464 rr.h:= r.h;

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

   466    begin

   467    Writeln('Blit: ', SDL_GetError);

   468    exit

   469    end;

   470 end;

   471 

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

   473 begin

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

   475 end;

   476 

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

   478 begin

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

   480 r.h:= Height;

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

   482 end;

   483 

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

   485 var r: TSDL_Rect;

   486 begin

   487 r.x:= 0;

   488 r.w:= SpritesData[Sprite].Width;

   489 r.y:= Position * SpritesData[Sprite].Height;

   490 r.h:= SpritesData[Sprite].Height;

   491 DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)

   492 end;

   493 

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

   495 var clr: TSDL_Color;

   496     tmpsurf: PSDL_Surface;

   497     r: TSDL_Rect;

   498 begin

   499 r.x:= X;

   500 r.y:= Y;

   501 SDL_GetRGB(cWhiteColor, PixelFormat, @clr.r, @clr.g, @clr.b);

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

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

   504 SDL_FreeSurface(tmpsurf)

   505 end;

   506 

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

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

   509 begin

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

   511 end;

   512 

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

   514 begin

   515 if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface,  Surface)

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

   517 end;

   518 

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

   520 var r: TSDL_Rect;

   521 begin

   522 r.x:= Step * 32;

   523 r.y:= Pos * 32;

   524 if Dir = -1 then r.x:= cHHSurfaceWidth - 32 - r.x;

   525 r.w:= 32;

   526 r.h:= 32;

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

   528 end;

   529 

   530 procedure StoreRelease;

   531 var ii: TSprite;

   532 begin

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

   534     SDL_FreeSurface(SpritesData[ii].Surface);

   535 SDL_FreeSurface(  HHSurface  );

   536 SDL_FreeSurface(TempSurface  );

   537 SDL_FreeSurface(LandSurface  );

   538 SDL_FreeSurface(StoreSurface )

   539 end;

   540 

   541 procedure RenderHealth(var Hedgehog: THedgehog);

   542 var s: string;

   543 begin

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

   545 Hedgehog.HealthRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s);

   546 if Hedgehog.Gear.Damage > 0 then

   547    begin

   548    str(Hedgehog.Gear.Damage, s);

   549    Hedgehog.HealthTagRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x + Hedgehog.HealthRect.w, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s)

   550    end;

   551 end;

   552 

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

   554 begin

   555 Result:= WriteInRoundRect(TempSurface, 64, Pos * Fontz[fntBig].Height, Color, fntBig, s);

   556 end;

   557 

   558 procedure AddProgress;

   559 const Step: Longword = 0;

   560       ProgrSurf: PSDL_Surface = nil;

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

   562 var r: TSDL_Rect;

   563 begin

   564 if Step = 0 then

   565    begin

   566    WriteToConsole(msgLoading + 'progress sprite... ');

   567    ProgrSurf:= IMG_Load(PChar(string('Data\Graphics\BigDigits.png')));

   568    SDLTry(ProgrSurf <> nil, true);

   569    WriteLnToConsole(msgOK)

   570    end;

   571 SDL_FillRect(SDLPrimSurface, nil, 0);

   572 r.x:= 0;

   573 r.w:= 32;

   574 r.h:= 32;

   575 r.y:= Step * 32;

   576 DrawFromRect(cScreenWidth div 2 - 16, cScreenHeight div 2 - 16, @r, ProgrSurf, SDLPrimSurface);

   577 SDL_Flip(SDLPrimSurface);

   578 inc(Step);

   579 if Step = MaxCalls then

   580    begin

   581    WriteLnToConsole('Freeing progress surface... ');

   582    SDL_FreeSurface(ProgrSurf)

   583    end;

   584 end;

   585 

   586 function  LoadImage(filename: string): PSDL_Surface;

   587 begin

   588 WriteToConsole(msgLoading + filename + '... ');

   589 Result:= IMG_Load(PChar(filename));

   590 TryDo(Result <> nil, msgFailed, true);

   591 WriteLnToConsole(msgOK)

   592 end;

   593 

   594 end.