hedgewars/uStore.pas
changeset 38 c1ec4b15d70e
parent 37 2b7f2a43b999
child 42 72ffe21f027c
equal deleted inserted replaced
37:2b7f2a43b999 38:c1ec4b15d70e
    50 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
    50 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
    51 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
    51 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
    52 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
    52 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
    53 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
    53 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
    54 procedure DrawExplosion(X, Y, Radius: integer);
    54 procedure DrawExplosion(X, Y, Radius: integer);
    55 procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
    55 procedure DrawHLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
       
    56 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
    56 procedure RenderHealth(var Hedgehog: THedgehog);
    57 procedure RenderHealth(var Hedgehog: THedgehog);
    57 function  RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
    58 function  RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
    58 procedure AddProgress;
    59 procedure AddProgress;
    59 function  LoadImage(filename: string; hasAlpha: boolean): PSDL_Surface;
    60 function  LoadImage(filename: string; hasAlpha: boolean): PSDL_Surface;
    60 
    61 
    67 var StoreSurface,
    68 var StoreSurface,
    68      TempSurface,
    69      TempSurface,
    69        HHSurface: PSDL_Surface;
    70        HHSurface: PSDL_Surface;
    70 
    71 
    71 procedure DrawExplosion(X, Y, Radius: integer);
    72 procedure DrawExplosion(X, Y, Radius: integer);
    72 var ty, tx: integer;
    73 var ty, tx, p: integer;
    73     p: integer;
       
    74 begin
    74 begin
    75 for ty:= max(-Radius, -y) to min(radius, 1023 - y) do
    75 for ty:= max(-Radius, -y) to min(radius, 1023 - y) do
    76     for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
    76     for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
    77         Land[ty + y, tx]:= 0;
    77         Land[ty + y, tx]:= 0;
    78 
    78 
    79 if SDL_MustLock(LandSurface) then
    79 if SDL_MustLock(LandSurface) then
    80    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
    80    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
    81 
    81 
    82 p:= Longword(LandSurface.pixels);
    82 p:= integer(LandSurface.pixels);
    83 case LandSurface.format.BytesPerPixel of
    83 case LandSurface.format.BytesPerPixel of
    84      1: ;// not supported
    84      1: ;// not supported
    85      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
    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
    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;
    87                 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
   101 
   101 
   102 case LandSurface.format.BytesPerPixel of
   102 case LandSurface.format.BytesPerPixel of
   103      1: ;// not supported
   103      1: ;// not supported
   104      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   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
   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 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then
   106                if Land[y + ty, tx] <> 0 then
   107                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
   107                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
   108      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   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
   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 (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)
   110                if Land[y + ty, tx] <> 0 then
   111                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)
   111                 begin
   112                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)
       
   113                 then begin
       
   114                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
   112                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
   115                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
   113                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
   116                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
   114                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
   117                 end;
   115                 end;
   118      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   116      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   119             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) 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
   120                 if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then
   118                if Land[y + ty, tx] <> 0 then
   121                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
   119                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
   122      end;
   120      end;
   123 
   121 
   124 if SDL_MustLock(LandSurface) then
   122 if SDL_MustLock(LandSurface) then
   125    SDL_UnlockSurface(LandSurface);
   123    SDL_UnlockSurface(LandSurface);
   126 
   124 
   127 SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2)
   125 SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2)
   128 end;
   126 end;
   129 
   127 
   130 procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
   128 procedure DrawHLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
   131 var tx, ty, i, p: integer;
   129 var tx, ty, i, p: integer;
   132 begin
   130 begin
   133 if SDL_MustLock(LandSurface) then
   131 if SDL_MustLock(LandSurface) then
   134    SDL_LockSurface(LandSurface);
   132    SDL_LockSurface(LandSurface);
   135 
   133 
   136 p:= Longword(LandSurface.pixels);
   134 p:= integer(LandSurface.pixels);
   137 for i:= 0 to Pred(Count) do
   135 for i:= 0 to Pred(Count) do
   138     begin
   136     begin
   139     case LandSurface.format.BytesPerPixel of
   137     case LandSurface.format.BytesPerPixel of
   140      1: ;
   138      1: ;
   141      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   139      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   162     begin
   160     begin
   163     case LandSurface.format.BytesPerPixel of
   161     case LandSurface.format.BytesPerPixel of
   164      1: ;
   162      1: ;
   165      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   163      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   166             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
   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
   167                if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then
   165                if Land[y + ty, tx] <> 0 then
   168                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
   166                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
   169      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   167      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   170             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
   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
   171                 if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)
   169                if Land[y + ty, tx] <> 0 then
   172                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)
   170                 begin
   173                 or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)
       
   174                 then begin
       
   175                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
   171                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
   176                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
   172                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
   177                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
   173                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
   178                 end;
   174                 end;
   179      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   175      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
   180             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
   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
   181                 if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then
   177                if Land[y + ty, tx] <> 0 then
   182                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
   178                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
   183      end;
   179      end;
   184     inc(y, dY)
   180     inc(y, dY)
   185     end;
   181     end;
   186 
   182 
   187 if SDL_MustLock(LandSurface) then
   183 if SDL_MustLock(LandSurface) then
   188    SDL_UnlockSurface(LandSurface);
   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)
   189 end;
   258 end;
   190 
   259 
   191 procedure StoreInit;
   260 procedure StoreInit;
   192 begin
   261 begin
   193 StoreSurface  := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
   262 StoreSurface  := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);