hedgewars/uStore.pas
changeset 54 839fd258ae6f
parent 53 0e27949850e3
child 55 e09f7c952a40
equal deleted inserted replaced
53:0e27949850e3 54:839fd258ae6f
    34 unit uStore;
    34 unit uStore;
    35 interface
    35 interface
    36 uses uConsts, uTeams, SDLh;
    36 uses uConsts, uTeams, SDLh;
    37 {$INCLUDE options.inc}
    37 {$INCLUDE options.inc}
    38 
    38 
    39 type PRangeArray = ^TRangeArray;
       
    40      TRangeArray = array[0..31] of record
       
    41                                    Left, Right: integer;
       
    42                                    end;
       
    43 
       
    44 procedure StoreInit;
    39 procedure StoreInit;
    45 procedure StoreLoad;
    40 procedure StoreLoad;
    46 procedure StoreRelease;
    41 procedure StoreRelease;
    47 procedure DrawGear(Stuff : TStuff; X, Y: integer; Surface: PSDL_Surface);
    42 procedure DrawGear(Stuff : TStuff; X, Y: integer; Surface: PSDL_Surface);
    48 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
    43 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
    51 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
    46 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
    52 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
    47 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
    53 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
    48 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
    54 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
    49 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
    55 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
    50 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
    56 procedure DrawExplosion(X, Y, Radius: integer);
       
    57 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
       
    58 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
       
    59 procedure RenderHealth(var Hedgehog: THedgehog);
    51 procedure RenderHealth(var Hedgehog: THedgehog);
    60 function  RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
    52 function  RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
    61 procedure AddProgress;
    53 procedure AddProgress;
    62 function  LoadImage(filename: string; hasAlpha: boolean): PSDL_Surface;
    54 function  LoadImage(filename: string; hasAlpha: boolean): PSDL_Surface;
    63 
    55 
    68 uses uMisc, uIO, uConsole, uLand, uCollisions;
    60 uses uMisc, uIO, uConsole, uLand, uCollisions;
    69 
    61 
    70 var StoreSurface,
    62 var StoreSurface,
    71      TempSurface,
    63      TempSurface,
    72        HHSurface: PSDL_Surface;
    64        HHSurface: PSDL_Surface;
    73 
       
    74 procedure DrawExplosion(X, Y, Radius: integer);
       
    75 var ty, tx, p: integer;
       
    76 begin
       
    77 FillRoundInLand(X, Y, Radius, 0);
       
    78 
       
    79 if SDL_MustLock(LandSurface) then
       
    80    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
       
    81 
       
    82 p:= integer(LandSurface.pixels);
       
    83 case LandSurface.format.BytesPerPixel of
       
    84      1: ;// not supported
       
    85      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
    86             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
       
    87                 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
       
    88      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
    89             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
       
    90                 begin
       
    91                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;
       
    92                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;
       
    93                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;
       
    94                 end;
       
    95      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
    96             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
       
    97                 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;
       
    98      end;
       
    99 
       
   100 inc(Radius, 4);
       
   101 
       
   102 case LandSurface.format.BytesPerPixel of
       
   103      1: ;// not supported
       
   104      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   105             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
       
   106                if Land[y + ty, tx] = $FFFFFF then
       
   107                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
       
   108      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   109             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
       
   110                if Land[y + ty, tx] = $FFFFFF then
       
   111                 begin
       
   112                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
       
   113                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
       
   114                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
       
   115                 end;
       
   116      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   117             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
       
   118                if Land[y + ty, tx] = $FFFFFF then
       
   119                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
       
   120      end;
       
   121 
       
   122 if SDL_MustLock(LandSurface) then
       
   123    SDL_UnlockSurface(LandSurface);
       
   124 
       
   125 SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2)
       
   126 end;
       
   127 
       
   128 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
       
   129 var tx, ty, i, p: integer;
       
   130 begin
       
   131 if SDL_MustLock(LandSurface) then
       
   132    SDL_LockSurface(LandSurface);
       
   133 
       
   134 p:= integer(LandSurface.pixels);
       
   135 for i:= 0 to Pred(Count) do
       
   136     begin
       
   137     case LandSurface.format.BytesPerPixel of
       
   138      1: ;
       
   139      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   140             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
       
   141                 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
       
   142      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   143             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
       
   144                 begin
       
   145                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;
       
   146                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;
       
   147                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;
       
   148                 end;
       
   149      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   150             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
       
   151                 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;
       
   152      end;
       
   153     inc(y, dY)
       
   154     end;
       
   155 
       
   156 inc(Radius, 4);
       
   157 dec(y, Count*dY);
       
   158 
       
   159 for i:= 0 to Pred(Count) do
       
   160     begin
       
   161     case LandSurface.format.BytesPerPixel of
       
   162      1: ;
       
   163      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   164             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
       
   165                if Land[y + ty, tx] = $FFFFFF then
       
   166                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
       
   167      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   168             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
       
   169                if Land[y + ty, tx] = $FFFFFF then
       
   170                 begin
       
   171                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
       
   172                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
       
   173                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
       
   174                 end;
       
   175      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
       
   176             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
       
   177                if Land[y + ty, tx] = $FFFFFF then
       
   178                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
       
   179      end;
       
   180     inc(y, dY)
       
   181     end;
       
   182 
       
   183 if SDL_MustLock(LandSurface) then
       
   184    SDL_UnlockSurface(LandSurface);
       
   185 end;
       
   186 
       
   187 //
       
   188 //  - (dX, dY) - direction, vector of length = 0.5
       
   189 //
       
   190 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
       
   191 var nx, ny: real;
       
   192     i, t, tx, ty, p: integer;
       
   193 begin  // (-dY, dX) is (dX, dY) turned by PI/2
       
   194 if SDL_MustLock(LandSurface) then
       
   195    SDL_LockSurface(LandSurface);
       
   196 
       
   197 nx:= X + dY * (HalfWidth + 8);
       
   198 ny:= Y - dX * (HalfWidth + 8);
       
   199 p:= integer(LandSurface.pixels);
       
   200 
       
   201 for i:= 0 to 7 do
       
   202     begin
       
   203     X:= nx - 8 * dX;
       
   204     Y:= ny - 8 * dY;
       
   205     for t:= -8 to ticks + 8 do
       
   206         {$include tunsetborder.inc}
       
   207     nx:= nx - dY;
       
   208     ny:= ny + dX;
       
   209     end;
       
   210 
       
   211 for i:= -HalfWidth to HalfWidth do
       
   212     begin
       
   213     X:= nx - dX * 8;
       
   214     Y:= ny - dY * 8;
       
   215     for t:= 0 to 7 do
       
   216         {$include tunsetborder.inc}
       
   217     X:= nx;
       
   218     Y:= ny;
       
   219     for t:= 0 to ticks do
       
   220         begin
       
   221         X:= X + dX;
       
   222         Y:= Y + dY;
       
   223         tx:= round(X);
       
   224         ty:= round(Y);
       
   225         if ((ty and $FFFFFC00) = 0) and ((tx and $FFFFF800) = 0) then
       
   226            begin
       
   227            Land[ty, tx]:= 0;
       
   228            case LandSurface.format.BytesPerPixel of
       
   229                 1: ;
       
   230                 2: PWord(p + LandSurface.pitch * ty + tx * 2)^:= 0;
       
   231                 3: begin
       
   232                    PByte(p + LandSurface.pitch * ty + tx * 3 + 0)^:= 0;
       
   233                    PByte(p + LandSurface.pitch * ty + tx * 3 + 1)^:= 0;
       
   234                    PByte(p + LandSurface.pitch * ty + tx * 3 + 2)^:= 0;
       
   235                    end;
       
   236                 4: PLongword(p + LandSurface.pitch * ty + tx * 4)^:= 0;
       
   237                 end
       
   238            end
       
   239         end;
       
   240     for t:= 0 to 7 do
       
   241         {$include tunsetborder.inc}
       
   242     nx:= nx - dY;
       
   243     ny:= ny + dX;
       
   244     end;
       
   245 
       
   246 for i:= 0 to 7 do
       
   247     begin
       
   248     X:= nx - 8 * dX;
       
   249     Y:= ny - 8 * dY;
       
   250     for t:= -8 to ticks + 8 do
       
   251         {$include tunsetborder.inc}
       
   252     nx:= nx - dY;
       
   253     ny:= ny + dX;
       
   254     end;
       
   255 
       
   256 if SDL_MustLock(LandSurface) then
       
   257    SDL_UnlockSurface(LandSurface)
       
   258 end;
       
   259 
    65 
   260 procedure StoreInit;
    66 procedure StoreInit;
   261 begin
    67 begin
   262 StoreSurface  := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
    68 StoreSurface  := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
   263 TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
    69 TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);