(*
* Hedgewars, a worms-like game
* Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
*
* 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[byte] 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 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 DrawHLineExplosions(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 DrawHLineExplosions(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_FillRect(Surface, @Result, 0);
Result.w:= 1;
Result.y:= Y + 1;
Result.h:= h + 4;
SDL_FillRect(Surface, @Result, cWhiteColor);
Result.x:= X + w + 5;
SDL_FillRect(Surface, @Result, cWhiteColor);
Result.x:= X + 1;
Result.w:= w + 4;
Result.y:= Y;
Result.h:= 1;
SDL_FillRect(Surface, @Result, cWhiteColor);
Result.y:= Y + h + 5;
SDL_FillRect(Surface, @Result, cWhiteColor);
Result.x:= X + 1;
Result.y:= Y + 1;
Result.h:= h + 4;
SDL_FillRect(Surface, @Result, cColorNearBlack);
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;
r: TSDL_Rect;
begin
r.x:= 0;
r.y:= 272;
Team:= TeamsList;
while Team<>nil do
begin
r.w:= 1968;
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);
WriteLnToConsole(msgOK)
end;
AddProgress;
//s:= Pathz[ptMapCurrent] + cLandFileName;
//WriteToConsole(msgLoading + s + ' ');
//tmpsurf:= IMG_Load(PChar(s));
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;
GetSkyColor;
AddProgress;
for ii:= Low(TSprite) to High(TSprite) do
with SpritesData[ii] do
Surface:= LoadImage(Pathz[Path] + FileName, hasAlpha);
AddProgress;
tmpsurf:= LoadImage(Pathz[ptGraphics] + cHHFileName, false);
TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
HHSurface:= SDL_DisplayFormat(tmpsurf);
SDL_FreeSurface(tmpsurf);
InitHealth;
{$IFDEF DUMP}
SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
SDL_SaveBMP_RW(TempSurface, SDL_RWFromFile('TempSurface.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;
rr.w:= r.w;
rr.h:= r.h;
if SDL_UpperBlit(SourceSurface, r, DestSurface, @rr) < 0 then
begin
Writeln('Blit: ', SDL_GetError);
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, Position: integer; Surface: PSDL_Surface);
var r: TSDL_Rect;
begin
r.x:= 0;
r.w:= SpritesData[Sprite].Width;
r.y:= Position * SpritesData[Sprite].Height;
r.h:= SpritesData[Sprite].Height;
DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, 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;
SDL_GetRGB(cWhiteColor, PixelFormat, @clr.r, @clr.g, @clr.b);
tmpsurf:= TTF_RenderText_Solid(Fontz[Font].Handle, PChar(s), clr);
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 DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
begin
if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface, Surface)
else DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
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;
if Dir = -1 then r.x:= cHHSurfaceWidth - 32 - r.x;
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(TempSurface );
SDL_FreeSurface(LandSurface );
SDL_FreeSurface(StoreSurface )
end;
procedure RenderHealth(var Hedgehog: THedgehog);
var s: string[15];
begin
str(Hedgehog.Gear.Health, s);
Hedgehog.HealthRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s);
if Hedgehog.Gear.Damage > 0 then
begin
str(Hedgehog.Gear.Damage, s);
Hedgehog.HealthTagRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x + Hedgehog.HealthRect.w, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s)
end;
end;
function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
begin
Result:= WriteInRoundRect(TempSurface, 64, Pos * Fontz[fntBig].Height, Color, fntBig, s);
end;
procedure AddProgress;
const Step: Longword = 0;
ProgrSurf: PSDL_Surface = nil;
MaxCalls = 10; // 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... ');
ProgrSurf:= IMG_Load(PChar(string('Data/Graphics/BigDigits.png')));
SDLTry(ProgrSurf <> nil, true);
WriteLnToConsole(msgOK)
end;
SDL_FillRect(SDLPrimSurface, nil, 0);
r.x:= 0;
r.w:= 32;
r.h:= 32;
r.y:= Step * 32;
DrawFromRect(cScreenWidth div 2 - 16, cScreenHeight div 2 - 16, @r, ProgrSurf, SDLPrimSurface);
SDL_Flip(SDLPrimSurface);
inc(Step);
if Step = MaxCalls then
begin
WriteLnToConsole('Freeing progress surface... ');
SDL_FreeSurface(ProgrSurf)
end;
end;
function LoadImage(filename: string; hasAlpha: boolean): PSDL_Surface;
var tmpsurf: PSDL_Surface;
begin
WriteToConsole(msgLoading + filename + '... ');
tmpsurf:= IMG_Load(PChar(filename));
TryDo(tmpsurf <> nil, msgFailed, true);
TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
if cFullScreen then
begin
if hasAlpha then Result:= SDL_DisplayFormatAlpha(tmpsurf)
else Result:= SDL_DisplayFormat(tmpsurf);
SDL_FreeSurface(tmpsurf);
end else Result:= tmpsurf;
WriteLnToConsole(msgOK)
end;
end.