diff -r c3ccec3834e8 -r 29bc9c36ad5f hedgewars/uStore.pas --- 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.