diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uStore.pas --- a/hedgewars/uStore.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uStore.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,594 +1,594 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * 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 DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte); -procedure RenderHealth(var Hedgehog: THedgehog); -function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect; -procedure AddProgress; -function LoadImage(filename: string): 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: integer; - 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:= Longword(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 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 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 (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 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 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 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 DrawLineExplosions(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:= Longword(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 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 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 (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 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 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 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; - -procedure StoreInit; -begin -StoreSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0); -TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true); - -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); - 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 or SDL_RLEACCEL, 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 - begin - Surface:= LoadImage(Pathz[Path] + FileName); - TryDo(SDL_SetColorKey(Surface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true) - end; - -AddProgress; -tmpsurf:= LoadImage(Pathz[ptGraphics] + cHHFileName); -HHSurface:= SDL_DisplayFormat(tmpsurf); -SDL_FreeSurface(tmpsurf); -TryDo(SDL_SetColorKey(HHSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true); - -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; -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): PSDL_Surface; -begin -WriteToConsole(msgLoading + filename + '... '); -Result:= IMG_Load(PChar(filename)); -TryDo(Result <> nil, msgFailed, true); -WriteLnToConsole(msgOK) -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte); +procedure RenderHealth(var Hedgehog: THedgehog); +function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect; +procedure AddProgress; +function LoadImage(filename: string): 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: integer; + 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:= Longword(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 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 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 (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0) + or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0) + or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 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 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 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 DrawLineExplosions(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:= Longword(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 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 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 (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0) + or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0) + or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 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 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 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; + +procedure StoreInit; +begin +StoreSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0); +TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true); + +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); + 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 or SDL_RLEACCEL, 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 + begin + Surface:= LoadImage(Pathz[Path] + FileName); + TryDo(SDL_SetColorKey(Surface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true) + end; + +AddProgress; +tmpsurf:= LoadImage(Pathz[ptGraphics] + cHHFileName); +HHSurface:= SDL_DisplayFormat(tmpsurf); +SDL_FreeSurface(tmpsurf); +TryDo(SDL_SetColorKey(HHSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true); + +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; +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): PSDL_Surface; +begin +WriteToConsole(msgLoading + filename + '... '); +Result:= IMG_Load(PChar(filename)); +TryDo(Result <> nil, msgFailed, true); +WriteLnToConsole(msgOK) +end; + +end.