Mercurial Mercurial > sheepy-clone / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uLandGraphics.pas
changeset 101 f568cc72ea8c
parent 64 9df467527ae5
child 107 b08ce0293a51
equal deleted inserted replaced
100:f324a18698fe 101:f568cc72ea8c 
     5      TRangeArray = array[0..31] of record
 
     5      TRangeArray = array[0..31] of record
 
     6                                    Left, Right: integer;
 
     6                                    Left, Right: integer;
 
     7                                    end;
 
     7                                    end;
 
     8 
     8 
     9 procedure DrawExplosion(X, Y, Radius: integer);
 
     9 procedure DrawExplosion(X, Y, Radius: integer);
 
    10 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
 
    10 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: integer; y, dY: integer; Count: Byte);
 
    11 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
 
    11 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
 
    12 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword);
 
    12 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword);
 
    13 
    13 
    14 implementation
 
    14 implementation
 
    15 uses SDLh, uStore, uMisc, uLand, uConsts;
 
    15 uses SDLh, uStore, uMisc, uLand, uConsts;
 
    46      end;
 
    46      end;
 
    47   if (dx = dy) then FillCircleLines(x, y, dx, dy, Value);
 
    47   if (dx = dy) then FillCircleLines(x, y, dx, dy, Value);
 
    48 end;
 
    48 end;
 
    49 
    49 
    50 procedure ClearLandPixel(y, x: integer);
 
    50 procedure ClearLandPixel(y, x: integer);
 
    51 var p: integer;
 
    51 var p: PByteArray;
 
    52 begin
 
    52 begin
 
    53 p:= integer(LandSurface.pixels);
 
    53 p:= @PByteArray(LandSurface.pixels)^[LandSurface.pitch*y];
 
    54 case LandSurface.format.BytesPerPixel of
 
    54 case LandSurface.format.BytesPerPixel of
 
    55      1: ;// not supported
 
    55      1: ;// not supported
 
    56      2: PWord(p + LandSurface.pitch*y + x * 2)^:= 0;
 
    56      2: PWord(@p[x * 2])^:= 0;
 
    57      3: begin
 
    57      3: begin
 
    58         PByte(p + LandSurface.pitch*y + x * 3 + 0)^:= 0;
 
    58         p[x * 3 + 0]:= 0;
 
    59         PByte(p + LandSurface.pitch*y + x * 3 + 1)^:= 0;
 
    59         p[x * 3 + 1]:= 0;
 
    60         PByte(p + LandSurface.pitch*y + x * 3 + 2)^:= 0;
 
    60         p[x * 3 + 2]:= 0;
 
    61         end;
 
    61         end;
 
    62      4: PLongword(p + LandSurface.pitch*y + x * 4)^:= 0;
 
    62      4: PLongword(@p[x * 4])^:= 0;
 
    63      end;
 
    63      end
 
    64 end;
 
    64 end;
 
    65 
    65 
    66 procedure SetLandPixel(y, x: integer);
 
    66 procedure SetLandPixel(y, x: integer);
 
    67 var p: integer;
 
    67 var p: PByteArray;
 
    68 begin
 
    68 begin
 
    69 p:= integer(LandSurface.pixels);
 
    69 p:= @PByteArray(LandSurface.pixels)^[LandSurface.pitch*y];
 
    70 case LandSurface.format.BytesPerPixel of
 
    70 case LandSurface.format.BytesPerPixel of
 
    71      1: ;// not supported
 
    71      1: ;// not supported
 
    72      2: PWord(p + LandSurface.pitch*y + x * 2)^:= cExplosionBorderColor;
 
    72      2: PWord(@p[x * 2])^:= cExplosionBorderColor;
 
    73      3: begin
 
    73      3: begin
 
    74      PByte(p + LandSurface.pitch*y + x * 3 + 0)^:= cExplosionBorderColor and $FF;
 
    74         p[x * 3 + 0]:= cExplosionBorderColor and $FF;
 
    75      PByte(p + LandSurface.pitch*y + x * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
 
    75         p[x * 3 + 1]:= (cExplosionBorderColor shr 8) and $FF;
 
    76      PByte(p + LandSurface.pitch*y + x * 3 + 2)^:= (cExplosionBorderColor shr 16);
 
    76         p[x * 3 + 2]:= cExplosionBorderColor shr 16;
 
    77         end;
 
    77         end;
 
    78      4: PLongword(p + LandSurface.pitch*y + x * 4)^:= cExplosionBorderColor;
 
    78      4: PLongword(@p[x * 4])^:= cExplosionBorderColor;
 
    79      end;
 
    79      end
 
    80 end;
 
    80 end;
 
    81 
    81 
    82 procedure FillLandCircleLines0(x, y, dx, dy: integer);
 
    82 procedure FillLandCircleLines0(x, y, dx, dy: integer);
 
    83 var i: integer;
 
    83 var i: integer;
 
    84 begin
 
    84 begin
 
   151   
   151   
   152 if SDL_MustLock(LandSurface) then
 
   152 if SDL_MustLock(LandSurface) then
 
   153    SDL_UnlockSurface(LandSurface);
 
   153    SDL_UnlockSurface(LandSurface);
 
   154 end;
 
   154 end;
 
   155 
   155 
   156 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
 
   156 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: integer; y, dY: integer; Count: Byte);
 
   157 var tx, ty, i, p: integer;
 
   157 var tx, ty, i: integer;
 
   158 begin
 
   158 begin
 
   159 if SDL_MustLock(LandSurface) then
 
   159 if SDL_MustLock(LandSurface) then
 
   160    SDL_LockSurface(LandSurface);
 
   160    SDL_LockSurface(LandSurface);
 
   161 
   161 
   162 p:= integer(LandSurface.pixels);
 
       
   163 for i:= 0 to Pred(Count) do
 
   162 for i:= 0 to Pred(Count) do
 
   164     begin
 
   163     begin
 
   165     case LandSurface.format.BytesPerPixel of
 
   164     for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
   166      1: ;
 
   165         for tx:= max(0, ar[i].Left - Radius) to min(2047, ar[i].Right + Radius) do
 
   167      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
   166             ClearLandPixel(y + ty, tx);
 
   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                 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
 
       
   170      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
       
   171             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
 
       
   172                 begin
 
       
   173                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;
 
       
   174                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;
 
       
   175                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;
 
       
   176                 end;
 
       
   177      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
       
   178             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
 
       
   179                 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;
 
       
   180      end;
 
       
   181     inc(y, dY)
 
   167     inc(y, dY)
 
   182     end;
 
   168     end;
 
   183 
   169 
   184 inc(Radius, 4);
 
   170 inc(Radius, 4);
 
   185 dec(y, Count*dY);
 
   171 dec(y, Count*dY);
 
   186 
   172 
   187 for i:= 0 to Pred(Count) do
 
   173 for i:= 0 to Pred(Count) do
 
   188     begin
 
   174     begin
 
   189     case LandSurface.format.BytesPerPixel of
 
   175     for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
   190      1: ;
 
   176         for tx:= max(0, ar[i].Left - Radius) to min(2047, ar[i].Right + Radius) do
 
   191      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
   177             if Land[y + ty, tx] = $FFFFFF then
 
   192             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
 
   178                   SetLandPixel(y + ty, tx);
 
   193                if Land[y + ty, tx] = $FFFFFF then
 
       
   194                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
 
       
   195      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
       
   196             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
 
       
   197                if Land[y + ty, tx] = $FFFFFF then
 
       
   198                 begin
 
       
   199                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
 
       
   200                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
 
       
   201                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
 
       
   202                 end;
 
       
   203      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
 
       
   204             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
 
       
   205                if Land[y + ty, tx] = $FFFFFF then
 
       
   206                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
 
       
   207      end;
 
       
   208     inc(y, dY)
 
   179     inc(y, dY)
 
   209     end;
 
   180     end;
 
   210 
   181 
   211 if SDL_MustLock(LandSurface) then
 
   182 if SDL_MustLock(LandSurface) then
 
   212    SDL_UnlockSurface(LandSurface);
 
   183    SDL_UnlockSurface(LandSurface);
 
   215 //
 
   186 //
 
   216 //  - (dX, dY) - direction, vector of length = 0.5
 
   187 //  - (dX, dY) - direction, vector of length = 0.5
 
   217 //
 
   188 //
 
   218 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
 
   189 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
 
   219 var nx, ny: real;
 
   190 var nx, ny: real;
 
   220     i, t, tx, ty, p: integer;
 
   191     i, t, tx, ty: integer;
 
   221 begin  // (-dY, dX) is (dX, dY) turned by PI/2
 
   192 begin  // (-dY, dX) is (dX, dY) turned by PI/2
 
   222 if SDL_MustLock(LandSurface) then
 
   193 if SDL_MustLock(LandSurface) then
 
   223    SDL_LockSurface(LandSurface);
 
   194    SDL_LockSurface(LandSurface);
 
   224 
   195 
   225 nx:= X + dY * (HalfWidth + 8);
 
   196 nx:= X + dY * (HalfWidth + 8);
 
   226 ny:= Y - dX * (HalfWidth + 8);
 
   197 ny:= Y - dX * (HalfWidth + 8);
 
   227 p:= integer(LandSurface.pixels);
 
       
   228 
   198 
   229 for i:= 0 to 7 do
 
   199 for i:= 0 to 7 do
 
   230     begin
 
   200     begin
 
   231     X:= nx - 8 * dX;
 
   201     X:= nx - 8 * dX;
 
   232     Y:= ny - 8 * dY;
 
   202     Y:= ny - 8 * dY;
 
   251         tx:= round(X);
 
   221         tx:= round(X);
 
   252         ty:= round(Y);
 
   222         ty:= round(Y);
 
   253         if ((ty and $FFFFFC00) = 0) and ((tx and $FFFFF800) = 0) then
 
   223         if ((ty and $FFFFFC00) = 0) and ((tx and $FFFFF800) = 0) then
 
   254            begin
 
   224            begin
 
   255            Land[ty, tx]:= 0;
 
   225            Land[ty, tx]:= 0;
 
   256            case LandSurface.format.BytesPerPixel of
 
   226            ClearLandPixel(ty, tx);
 
   257                 1: ;
 
       
   258                 2: PWord(p + LandSurface.pitch * ty + tx * 2)^:= 0;
 
       
   259                 3: begin
 
       
   260                    PByte(p + LandSurface.pitch * ty + tx * 3 + 0)^:= 0;
 
       
   261                    PByte(p + LandSurface.pitch * ty + tx * 3 + 1)^:= 0;
 
       
   262                    PByte(p + LandSurface.pitch * ty + tx * 3 + 2)^:= 0;
 
       
   263                    end;
 
       
   264                 4: PLongword(p + LandSurface.pitch * ty + tx * 4)^:= 0;
 
       
   265                 end
 
       
   266            end
 
   227            end
 
   267         end;
 
   228         end;
 
   268     for t:= 0 to 7 do
 
   229     for t:= 0 to 7 do
 
   269         {$include tunsetborder.inc}
 
   230         {$include tunsetborder.inc}
 
   270     nx:= nx - dY;
 
   231     nx:= nx - dY;
sheepy-clone