--- a/hedgewars/uStore.pas Thu Jan 18 20:29:28 2007 +0000
+++ b/hedgewars/uStore.pas Sun Jan 21 19:51:02 2007 +0000
@@ -18,7 +18,7 @@
unit uStore;
interface
-uses uConsts, uTeams, SDLh;
+uses uConsts, uTeams, SDLh, uFloat;
{$INCLUDE options.inc}
procedure StoreInit;
@@ -35,10 +35,10 @@
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);
-function RenderString(s: string; Color: integer; font: THWFont): PSDL_Surface;
+function RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
procedure RenderHealth(var Hedgehog: THedgehog);
procedure AddProgress;
-function LoadImage(filename: string; hasAlpha: boolean; const critical: boolean = true; const setTransparent: boolean = true): PSDL_Surface;
+function LoadImage(filename: string; hasAlpha, critical, setTransparent: boolean): PSDL_Surface;
var PixelFormat: PSDL_PixelFormat;
SDLPrimSurface: PSDL_Surface;
@@ -52,7 +52,7 @@
procedure StoreInit;
begin
-StoreSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, PixelFormat.AMask);
+StoreSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
SDL_FillRect(StoreSurface, nil, 0);
@@ -63,53 +63,56 @@
var tmpsurf: PSDL_Surface;
rr: TSDL_Rect;
begin
- tmpsurf:= LoadImage(Filename, false);
+ tmpsurf:= LoadImage(Filename, false, true, false);
rr.x:= X;
rr.y:= Y;
SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
SDL_FreeSurface(tmpsurf);
end;
-procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface; const Clear: boolean = true);
+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);
-r.y:= rect.y + 1;
-r.h:= rect.h - 2;
+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;
+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;
+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;
+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: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
-var w, h: integer;
+var w, h: LongInt;
tmpsurf: PSDL_Surface;
clr: TSDL_Color;
+ Result: TSDL_Rect;
+ ps: array[byte] of char;
begin
-TTF_SizeUTF8(Fontz[Font].Handle, PChar(s), w, h);
+ps:= s;
+TTF_SizeUTF8(Fontz[Font].Handle, @ps, w, h);
Result.x:= X;
Result.y:= Y;
Result.w:= w + FontBorder * 2 + 4;
Result.h:= h + FontBorder * 2;
-DrawRoundRect(@Result, cWhiteColor, cColorNearBlack, Surface);
+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, PChar(s), clr.value);
+tmpsurf:= TTF_RenderUTF8_Blended(Fontz[Font].Handle, @ps, clr.value);
Result.x:= X + FontBorder + 2;
Result.y:= Y + FontBorder;
SDLTry(tmpsurf <> nil, true);
@@ -118,7 +121,8 @@
Result.x:= X;
Result.y:= Y;
Result.w:= w + FontBorder * 2 + 4;
-Result.h:= h + FontBorder * 2
+Result.h:= h + FontBorder * 2;
+WriteInRoundRect:= Result
end;
procedure StoreLoad;
@@ -141,22 +145,22 @@
while Team<>nil do
begin
r.w:= 104;
- Team.NameTag:= RenderString(Team.TeamName, Team.Color, Font);
+ Team^.NameTag:= RenderString(Team^.TeamName, Team^.Color, Font);
r.w:= cTeamHealthWidth + 5;
- r.h:= Team.NameTag.h;
- DrawRoundRect(@r, cWhiteColor, cColorNearBlack, StoreSurface);
- Team.HealthRect:= r;
+ r.h:= Team^.NameTag^.h;
+ DrawRoundRect(@r, cWhiteColor, cColorNearBlack, StoreSurface, true);
+ Team^.HealthRect:= r;
rr:= r;
inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);
- DrawRoundRect(@rr, Team.AdjColor, Team.AdjColor, StoreSurface, false);
+ DrawRoundRect(@rr, Team^.AdjColor, Team^.AdjColor, StoreSurface, false);
inc(r.y, r.h);
dec(drY, r.h + 2);
- Team.DrawHealthY:= drY;
+ Team^.DrawHealthY:= drY;
for i:= 0 to 7 do
- with Team.Hedgehogs[i] do
+ with Team^.Hedgehogs[i] do
if Gear <> nil then
- NameTag:= RenderString(Name, Team.Color, fnt16);
- Team:= Team.Next
+ NameTag:= RenderString(Name, Team^.Color, fnt16);
+ Team:= Team^.Next
end;
end;
@@ -166,19 +170,19 @@
s: string;
begin
s:= Pathz[ptGraphics] + '/' + cCHFileName;
- tmpsurf:= LoadImage(PChar(s), true, true, false);
+ tmpsurf:= LoadImage(s, true, true, false);
Team:= TeamsList;
while Team<>nil do
begin
- Team.CrosshairSurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, tmpsurf.w, tmpsurf.h, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, PixelFormat.AMask);
- TryDo(Team.CrosshairSurf <> nil, errmsgCreateSurface, true);
- SDL_FillRect(Team.CrosshairSurf, nil, Team.AdjColor);
- SDL_UpperBlit(tmpsurf, nil, Team.CrosshairSurf, nil);
- TryDo(SDL_SetColorKey(Team.CrosshairSurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
- Team:= Team.Next
+ Team^.CrosshairSurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, tmpsurf^.w, tmpsurf^.h, cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
+ TryDo(Team^.CrosshairSurf <> nil, errmsgCreateSurface, true);
+ SDL_FillRect(Team^.CrosshairSurf, nil, Team^.AdjColor);
+ SDL_UpperBlit(tmpsurf, nil, Team^.CrosshairSurf, nil);
+ TryDo(SDL_SetColorKey(Team^.CrosshairSurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
+ Team:= Team^.Next
end;
-
+
SDL_FreeSurface(tmpsurf)
end;
@@ -190,9 +194,9 @@
while p <> nil do
begin
for i:= 0 to cMaxHHIndex do
- if p.Hedgehogs[i].Gear <> nil then
- RenderHealth(p.Hedgehogs[i]);
- p:= p.Next
+ if p^.Hedgehogs[i].Gear <> nil then
+ RenderHealth(p^.Hedgehogs[i]);
+ p:= p^.Next
end
end;
@@ -205,13 +209,13 @@
while p <> nil do
begin
dec(l, 32);
- if p.GraveName = '' then p.GraveName:= 'Simple';
- LoadToSurface(Pathz[ptGraves] + '/' + p.GraveName, StoreSurface, l, 512);
- p.GraveRect.x:= l;
- p.GraveRect.y:= 512;
- p.GraveRect.w:= 32;
- p.GraveRect.h:= 256;
- p:= p.Next
+ if p^.GraveName = '' then p^.GraveName:= 'Simple';
+ LoadToSurface(Pathz[ptGraves] + '/' + p^.GraveName, StoreSurface, l, 512);
+ p^.GraveRect.x:= l;
+ p^.GraveRect.y:= 512;
+ p^.GraveRect.w:= 32;
+ p^.GraveRect.h:= 256;
+ p:= p^.Next
end
end;
@@ -220,8 +224,8 @@
begin
if SDL_MustLock(SpritesData[sprSky].Surface) then
SDLTry(SDL_LockSurface(SpritesData[sprSky].Surface) >= 0, true);
- p:= SpritesData[sprSky].Surface.pixels;
- case SpritesData[sprSky].Surface.format.BytesPerPixel of
+ p:= SpritesData[sprSky].Surface^.pixels;
+ case SpritesData[sprSky].Surface^.format^.BytesPerPixel of
1: cSkyColor:= PByte(p)^;
2: cSkyColor:= PWord(p)^;
3: cSkyColor:= (p^[0]) or (p^[1] shl 8) or (p^[2] shl 16);
@@ -237,11 +241,11 @@
begin
s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;
WriteToConsole(msgLoading + s + ' ');
- AssignFile(f, s);
+ Assign(f, s);
{$I-}
Reset(f);
Readln(f, s);
- Closefile(f);
+ Close(f);
{$I+}
TryDo(IOResult = 0, msgFailed, true);
WriteLnToConsole(msgOK);
@@ -249,13 +253,16 @@
AdjustColor(cExplosionBorderColor);
end;
+var ps: array[byte] of char;
+
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);
+ ps:= s;
+ Handle:= TTF_OpenFont(@ps, Height);
SDLTry(Handle <> nil, true);
TTF_SetFontStyle(Handle, style);
WriteLnToConsole(msgOK)
@@ -289,20 +296,20 @@
with SpritesData[ii] do
begin
if AltPath = ptNone then
- Surface:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha)
+ Surface:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha, true, true)
else begin
- Surface:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha, false);
+ Surface:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha, false, true);
if Surface = nil then
- Surface:= LoadImage(Pathz[AltPath] + '/' + FileName, hasAlpha)
+ Surface:= LoadImage(Pathz[AltPath] + '/' + FileName, hasAlpha, true, true)
end;
- if Width = 0 then Width:= Surface.w;
- if Height = 0 then Height:= Surface.h
+ if Width = 0 then Width:= Surface^.w;
+ if Height = 0 then Height:= Surface^.h
end;
GetSkyColor;
AddProgress;
-tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, false);
+tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, false, true, true);
TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
HHSurface:= SDL_DisplayFormat(tmpsurf);
SDL_FreeSurface(tmpsurf);
@@ -322,8 +329,8 @@
begin
rr.x:= X;
rr.y:= Y;
-rr.w:= r.w;
-rr.h:= r.h;
+rr.w:= r^.w;
+rr.h:= r^.h;
if SDL_UpperBlit(SourceSurface, r, DestSurface, @rr) < 0 then
begin
OutError('Blit: ' + SDL_GetError, true);
@@ -362,7 +369,7 @@
var r: TSDL_Rect;
begin
r.x:= 0;
-r.w:= Source.w;
+r.w:= Source^.w;
r.y:= Frame * Height;
r.h:= Height;
DrawFromRect(X, Y, @r, Source, Surface)
@@ -372,13 +379,15 @@
var clr: TSDL_Color;
tmpsurf: PSDL_Surface;
r: TSDL_Rect;
+ ps: array[byte] of Char;
begin
r.x:= X;
r.y:= Y;
clr.r:= $FF;
clr.g:= $FF;
clr.b:= $FF;
-tmpsurf:= TTF_RenderUTF8_Solid(Fontz[Font].Handle, PChar(s), clr.value);
+ps:= s;
+tmpsurf:= TTF_RenderUTF8_Solid(Fontz[Font].Handle, @ps, clr.value);
if tmpsurf = nil then
begin
SetKB(1);
@@ -407,10 +416,10 @@
procedure DrawCentered(X, Top: integer; Source, Surface: PSDL_Surface);
var r: TSDL_Rect;
begin
-r.x:= X - Source.w div 2;
+r.x:= X - Source^.w div 2;
r.y:= Top;
-r.w:= Source.w;
-r.h:= Source.h;
+r.w:= Source^.w;
+r.h:= Source^.h;
SDL_UpperBlit(Source, nil, Surface, @r)
end;
@@ -419,7 +428,7 @@
begin
r.x:= Step * 32;
r.y:= Pos * 32;
-if Dir = -1 then r.x:= HHSurface.w - 32 - r.x;
+if Dir = -1 then r.x:= HHSurface^.w - 32 - r.x;
r.w:= 32;
r.h:= 32;
DrawFromRect(X, Y, @r, HHSurface, Surface)
@@ -435,21 +444,25 @@
SDL_FreeSurface(StoreSurface )
end;
-function RenderString(s: string; Color: integer; font: THWFont): PSDL_Surface;
-var w, h: integer;
+function RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
+var w, h: Longint;
+ ps: array[byte] of Char;
+ Result: PSDL_Surface;
begin
-TTF_SizeUTF8(Fontz[font].Handle, PChar(s), w, h);
+ps:= s;
+TTF_SizeUTF8(Fontz[font].Handle, @ps, w, h);
Result:= SDL_CreateRGBSurface(SDL_HWSURFACE, w + FontBorder * 2 + 4, h + FontBorder * 2,
- cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, PixelFormat.AMask);
+ cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
TryDo(Result <> nil, 'RenderString: fail to create surface', true);
WriteInRoundRect(Result, 0, 0, Color, font, s);
-TryDo(SDL_SetColorKey(Result, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true)
+TryDo(SDL_SetColorKey(Result, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
+RenderString:= Result
end;
procedure RenderHealth(var Hedgehog: THedgehog);
var s: shortstring;
begin
-str(Hedgehog.Gear.Health, s);
+str(Hedgehog.Gear^.Health, s);
if Hedgehog.HealthTag <> nil then SDL_FreeSurface(Hedgehog.HealthTag);
Hedgehog.HealthTag:= RenderString(s, Hedgehog.Team^.Color, fnt16)
end;
@@ -463,7 +476,7 @@
if Step = 0 then
begin
WriteToConsole(msgLoading + 'progress sprite: ');
- ProgrSurf:= LoadImage(Pathz[ptGraphics] + '/BigDigits', false);
+ ProgrSurf:= LoadImage(Pathz[ptGraphics] + '/BigDigits', false, true, true);
end;
SDL_FillRect(SDLPrimSurface, nil, 0);
r.x:= 0;
@@ -480,26 +493,33 @@
end;
end;
-function LoadImage(filename: string; hasAlpha: boolean; const critical: boolean = true; const setTransparent: boolean = true): PSDL_Surface;
+function LoadImage(filename: string; hasAlpha: boolean; critical, setTransparent: boolean): PSDL_Surface;
var tmpsurf: PSDL_Surface;
+ ps: array[byte] of char;
+ Result: PSDL_Surface;
begin
WriteToConsole(msgLoading + filename + '... ');
-tmpsurf:= IMG_Load(PChar(filename + '.' + cBitsStr + '.png'));
+ps:= filename + '.' + cBitsStr + '.png';
+tmpsurf:= IMG_Load(@ps);
+
if tmpsurf = nil then
- tmpsurf:= IMG_Load(PChar(filename + '.png'));
+ begin
+ ps:= filename + '.png';
+ tmpsurf:= IMG_Load(ps);
+ end;
if tmpsurf = nil then
if critical then OutError(msgFailed, true)
else begin
WriteLnToConsole(msgFailed);
- Result:= nil;
- exit
+ exit(nil)
end;
-
+
if setTransparent then TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
if hasAlpha then Result:= SDL_DisplayFormatAlpha(tmpsurf)
else Result:= SDL_DisplayFormat(tmpsurf);
-WriteLnToConsole(msgOK)
+WriteLnToConsole(msgOK);
+LoadImage:= Result
end;
end.