Fix a bug screwing team selection up in network game
(REMOVETEAM message doesn't have teamID, and after
removing the team QMap still contains old info, when
add and remove team with the same name, total hedgehogs
number will be decreased by first team hh number)
(*
* Hedgewars, a free turn based strategy game
* Copyright (c) 2004-2008 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);
procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt);
procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt);
procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: PTexture);
procedure DrawLand (X, Y: LongInt);
procedure DrawTexture(X, Y: LongInt; Texture: PTexture);
procedure DrawTextureF(Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, Frames: LongInt);
procedure DrawRotated(Sprite: TSprite; X, Y, Dir: LongInt; Angle: real);
procedure DrawRotatedF(Sprite: TSprite; X, Y, Frame, Dir: LongInt; Angle: real);
procedure DrawRotatedTex(Tex: PTexture; hw, hh, X, Y, Dir: LongInt; Angle: real);
procedure DrawCentered(X, Top: LongInt; Source: PTexture);
procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture);
procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Angle: real);
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,
ConfirmTexture: 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 s: string;
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:= - 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
begin
NameTagTex:= RenderStringTex(Name, Clan^.Color, fnt16);
if Hat <> 'NoHat' then
begin
texsurf:= LoadImage(Pathz[ptHats] + '/' + Hat, false, true, false);
HatTex:= Surface2Tex(texsurf);
SDL_FreeSurface(texsurf)
end
end;
end;
end;
procedure MakeCrossHairs;
var t: LongInt;
tmpsurf, texsurf: PSDL_Surface;
Color, i: 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(tmpsurf^.format^.BytesPerPixel = 4, 'Ooops', true);
if SDL_MustLock(texsurf) then
SDLTry(SDL_LockSurface(texsurf) >= 0, true);
// make black pixel be alpha-transparent
for i:= 0 to texsurf^.w * texsurf^.h - 1 do
if PLongwordArray(texsurf^.pixels)^[i] = $FF000000 then PLongwordArray(texsurf^.pixels)^[i]:= 0;
if SDL_MustLock(texsurf) then
SDL_UnlockSurface(texsurf);
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;
var ii: TSprite;
fi: THWFont;
ai: TAmmoType;
tmpsurf: PSDL_Surface;
i: LongInt;
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;
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;
AddProgress;
tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, true, true, true);
HHTexture:= Surface2Tex(tmpsurf);
SDL_FreeSurface(tmpsurf);
InitHealth;
PauseTexture:= RenderStringTex(trmsg[sidPaused], $FFFF00, fntBig);
ConfirmTexture:= RenderStringTex(trmsg[sidConfirm], $FFFF00, fntBig);
for ai:= Low(TAmmoType) to High(TAmmoType) do
with Ammoz[ai] do
begin
tmpsurf:= TTF_RenderUTF8_Blended(Fontz[fnt16].Handle, Str2PChar(trAmmo[NameId]), $FFFFFF);
NameTex:= Surface2Tex(tmpsurf);
SDL_FreeSurface(tmpsurf)
end;
for i:= Low(CountTexz) to High(CountTexz) do
begin
tmpsurf:= TTF_RenderUTF8_Blended(Fontz[fnt16].Handle, Str2PChar(IntToStr(i) + 'x'), $FFFFFF);
CountTexz[i]:= Surface2Tex(tmpsurf);
SDL_FreeSurface(tmpsurf)
end;
{$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);
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);
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);
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 DrawTextureF(Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, Frames: LongInt);
var ft, fb: GLfloat;
hw: LongInt;
begin
glPushMatrix;
glTranslatef(X, Y, 0);
glScalef(Scale, Scale, 1.0);
if Dir < 0 then
hw:= - 16
else
hw:= 16;
ft:= Frame / Frames;
fb:= (Frame + 1) / Frames;
glBindTexture(GL_TEXTURE_2D, Texture^.id);
glBegin(GL_QUADS);
glTexCoord2f(0, ft);
glVertex2i(-hw, -16);
glTexCoord2f(1, ft);
glVertex2i(hw, -16);
glTexCoord2f(1, fb);
glVertex2i(hw, 16);
glTexCoord2f(0, fb);
glVertex2i(-hw, 16);
glEnd();
glPopMatrix
end;
procedure DrawRotated(Sprite: TSprite; X, Y, Dir: LongInt; Angle: real);
begin
DrawRotatedTex(SpritesData[Sprite].Texture,
SpritesData[Sprite].Width,
SpritesData[Sprite].Height,
X, Y, Dir, Angle)
end;
procedure DrawRotatedF(Sprite: TSprite; X, Y, Frame, Dir: LongInt; Angle: real);
begin
glPushMatrix;
glTranslatef(X, Y, 0);
glRotatef(Angle, 0, 0, 1);
if Dir < 0 then glScalef(-1.0, 1.0, 1.0);
DrawSprite(Sprite, -SpritesData[Sprite].Width div 2, -SpritesData[Sprite].Height div 2, Frame);
glPopMatrix
end;
procedure DrawRotatedTex(Tex: PTexture; hw, hh, X, Y, Dir: LongInt; Angle: real);
begin
glPushMatrix;
glTranslatef(X, Y, 0);
if Dir < 0 then
begin
hw:= - hw;
glRotatef(Angle, 0, 0, -1);
end else
glRotatef(Angle, 0, 0, 1);
glBindTexture(GL_TEXTURE_2D, Tex^.id);
glBegin(GL_QUADS);
glTexCoord2f(0, 0);
glVertex2i(-hw, -hh);
glTexCoord2f(1, 0);
glVertex2i(hw, -hh);
glTexCoord2f(1, 1);
glVertex2i(hw, hh);
glTexCoord2f(0, 1);
glVertex2i(-hw, hh);
glEnd();
glPopMatrix
end;
procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt);
begin
r.y:= r.y + Height * Position;
r.h:= Height;
DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture)
end;
procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt);
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)
end;
procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt);
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)
end;
procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: PTexture);
var r: TSDL_Rect;
begin
r.x:= 0;
r.w:= Source^.w;
r.y:= Frame * Height;
r.h:= Height;
DrawFromRect(X, Y, @r, Source)
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; Angle: real);
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;
glPushMatrix();
glTranslatef(X, Y, 0);
glRotatef(Angle, 0, 0, 1);
glBindTexture(GL_TEXTURE_2D, HHTexture^.id);
glBegin(GL_QUADS);
glTexCoord2f(l, t);
glVertex2i(-16, -16);
glTexCoord2f(r, t);
glVertex2i(16, -16);
glTexCoord2f(r, b);
glVertex2i(16, 16);
glTexCoord2f(l, b);
glVertex2i(-16, 16);
glEnd();
glPopMatrix
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)
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);
glEnable(GL_TEXTURE_2D);
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);
glDisable(GL_TEXTURE_2D);
SDL_GL_SwapBuffers();
inc(Step);
end;
procedure FinishProgress;
begin
WriteLnToConsole('Freeing progress surface... ');
FreeTexture(ProgrTex)
end;
end.