hedgewars/uLandGraphics.pas
changeset 7288 5d0704f23a2a
parent 7270 93e92e82d5c8
child 7492 3188794b9d87
equal deleted inserted replaced
7188:580cd247511e 7288:5d0704f23a2a
    34 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    34 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    35 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    35 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    38 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    38 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    39 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean);
    39 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
    40 function  LandBackPixel(x, y: LongInt): LongWord;
    40 function  LandBackPixel(x, y: LongInt): LongWord;
    41 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    41 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    42 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
    42 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
       
    43 procedure DumpLandToLog(x, y, r: LongInt);
    43 
    44 
    44 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean;
    45 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean;
    45 
    46 
    46 implementation
    47 implementation
    47 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
    48 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
    96     for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
    97     for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
    97         if (Land[y - dx, i] and lfIndestructible) = 0 then
    98         if (Land[y - dx, i] and lfIndestructible) = 0 then
    98             Land[y - dx, i]:= Value;
    99             Land[y - dx, i]:= Value;
    99 end;
   100 end;
   100 
   101 
   101 procedure ChangeCircleLines(x, y, dx, dy: LongInt; doSet: boolean);
   102 procedure ChangeCircleLines(x, y, dx, dy: LongInt; doSet, isCurrent: boolean);
   102 var i: LongInt;
   103 var i: LongInt;
   103 begin
   104 begin
   104 if not doSet then
   105 if not doSet then
   105     begin
   106     begin
   106     if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
   107     if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
   107         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
   108         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
   108             if (Land[y + dy, i] > 0) and (Land[y + dy, i] < 256) then
   109             if isCurrent then 
   109                 dec(Land[y + dy, i]); // check > 0 because explosion can erase collision data
   110                 Land[y + dy, i]:= Land[y + dy, i] and $FF7F
       
   111             else if Land[y + dy, i] and $007F > 0 then
       
   112                 Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) - 1);
   110     if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
   113     if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
   111         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
   114         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
   112             if (Land[y - dy, i] > 0) and (Land[y - dy, i] < 256) then
   115             if isCurrent then 
   113                 dec(Land[y - dy, i]);
   116                 Land[y - dy, i]:= Land[y - dy, i] and $FF7F
       
   117             else if Land[y - dy, i] and $007F > 0 then
       
   118                 Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) - 1);
   114     if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
   119     if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
   115         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
   120         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
   116             if (Land[y + dx, i] > 0) and (Land[y + dx, i] < 256) then
   121             if isCurrent then 
   117                 dec(Land[y + dx, i]);
   122                 Land[y + dx, i]:= Land[y + dx, i] and $FF7F
       
   123             else if Land[y + dx, i] and $007F > 0 then
       
   124                 Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) - 1);
   118     if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
   125     if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
   119         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
   126         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
   120             if (Land[y - dx, i] > 0) and (Land[y - dx, i] < 256) then
   127             if isCurrent then 
   121                 dec(Land[y - dx, i]);
   128                 Land[y - dx, i]:= Land[y - dx, i] and $FF7F
       
   129             else if Land[y - dx, i] and $007F > 0 then
       
   130                 Land[y - dx, i]:= (Land[y - dx, i] and $FF80) or ((Land[y - dx, i] and $7F) - 1)
   122     end
   131     end
   123 else
   132 else
   124     begin
   133     begin
   125     if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
   134     if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
   126         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
   135         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
   127             if (Land[y + dy, i] < 256) then
   136             if isCurrent then 
   128                 inc(Land[y + dy, i]);
   137                 Land[y + dy, i]:= Land[y + dy, i] or $80
   129     if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
   138             else if Land[y + dy, i] and $007F < 127 then
   130         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
   139                 Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) + 1);
   131             if (Land[y - dy, i] < 256) then
   140     if ((y - dy) and LAND_HEIGHT_MASK) = 0 then                                                   
   132                 inc(Land[y - dy, i]);
   141         for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do                                  
   133     if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
   142             if isCurrent then                                                                     
   134         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
   143                 Land[y - dy, i]:= Land[y - dy, i] or $80                                          
   135             if (Land[y + dx, i] < 256) then
   144             else if Land[y - dy, i] and $007F < 127 then                                          
   136                 inc(Land[y + dx, i]);
   145                 Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) + 1);
   137     if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
   146     if ((y + dx) and LAND_HEIGHT_MASK) = 0 then                                                   
   138         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
   147         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do                                  
   139             if (Land[y - dx, i] < 256) then
   148             if isCurrent then                                                                     
   140                 inc(Land[y - dx, i]);
   149                 Land[y + dx, i]:= Land[y + dx, i] or $80                                          
       
   150             else if Land[y + dx, i] and $007F < 127 then                                          
       
   151                 Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) + 1);
       
   152     if ((y - dx) and LAND_HEIGHT_MASK) = 0 then                                                   
       
   153         for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do                                  
       
   154             if isCurrent then                                                                     
       
   155                 Land[y - dx, i]:= Land[y - dx, i] or $80                                          
       
   156             else if Land[y - dx, i] and $007F < 127 then                                          
       
   157                 Land[y - dx, i]:= (Land[y - dx, i] and $FF80) or ((Land[y - dx, i] and $7F) + 1)
   141     end
   158     end
   142 end;
   159 end;
   143 
   160 
   144 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
   161 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
   145 var dx, dy, d: LongInt;
   162 var dx, dy, d: LongInt;
   161     end;
   178     end;
   162 if (dx = dy) then
   179 if (dx = dy) then
   163     FillCircleLines(x, y, dx, dy, Value);
   180     FillCircleLines(x, y, dx, dy, Value);
   164 end;
   181 end;
   165 
   182 
   166 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean);
   183 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
   167 var dx, dy, d: LongInt;
   184 var dx, dy, d: LongInt;
   168 begin
   185 begin
   169 dx:= 0;
   186 dx:= 0;
   170 dy:= Radius;
   187 dy:= Radius;
   171 d:= 3 - 2 * Radius;
   188 d:= 3 - 2 * Radius;
   172 while (dx < dy) do
   189 while (dx < dy) do
   173     begin
   190     begin
   174     ChangeCircleLines(x, y, dx, dy, doSet);
   191     ChangeCircleLines(x, y, dx, dy, doSet, isCurrent);
   175     if (d < 0) then
   192     if (d < 0) then
   176         d:= d + 4 * dx + 6
   193         d:= d + 4 * dx + 6
   177     else
   194     else
   178         begin
   195         begin
   179         d:= d + 4 * (dx - dy) + 10;
   196         d:= d + 4 * (dx - dy) + 10;
   180         dec(dy)
   197         dec(dy)
   181         end;
   198         end;
   182     inc(dx)
   199     inc(dx)
   183     end;
   200     end;
   184 if (dx = dy) then
   201 if (dx = dy) then
   185     ChangeCircleLines(x, y, dx, dy, doSet)
   202     ChangeCircleLines(x, y, dx, dy, doSet, isCurrent)
   186 end;
   203 end;
   187 
   204 
   188 procedure FillLandCircleLines0(x, y, dx, dy: LongInt);
   205 procedure FillLandCircleLines0(x, y, dx, dy: LongInt);
   189 var i, t: LongInt;
   206 var i, t: LongInt;
   190 begin
   207 begin
  1155         end;
  1172         end;
  1156     if (dx = dy) then
  1173     if (dx = dy) then
  1157         DrawLines(x1, y1, x2, y2, dx, dy, color);
  1174         DrawLines(x1, y1, x2, y2, dx, dy, color);
  1158 end;
  1175 end;
  1159 
  1176 
       
  1177 
       
  1178 procedure DumpLandToLog(x, y, r: LongInt);
       
  1179 var xx, yy, dx: LongInt;
       
  1180     s: shortstring;
       
  1181 begin
       
  1182     s[0]:= char(r * 2 + 1);
       
  1183     for yy:= y - r to y + r do
       
  1184         begin
       
  1185         for dx:= 0 to r*2 do
       
  1186             begin
       
  1187             xx:= dx - r + x;
       
  1188             if (xx = x) and (yy = y) then
       
  1189                 s[dx + 1]:= 'X'
       
  1190             else if Land[yy, xx] > 255 then
       
  1191                 s[dx + 1]:= 'O'
       
  1192             else if Land[yy, xx] > 0 then
       
  1193                 s[dx + 1]:= '*'
       
  1194             else
       
  1195                 s[dx + 1]:= '.'
       
  1196             end;
       
  1197         AddFileLog('Land dump: ' + s);
       
  1198         end;
       
  1199 end;
       
  1200 
  1160 end.
  1201 end.