Mercurial Mercurial > hedgewars / 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/uCollisions.pas
changeset 6580 6155187bf599
parent 6543 697e9b730189
child 6700 e04da46ee43c
equal deleted inserted replaced
6579:fc52f7c22c9b 6580:6155187bf599 
    24 
    24 
    25 const cMaxGearArrayInd = 1023;
 
    25 const cMaxGearArrayInd = 1023;
 
    26 
    26 
    27 type PGearArray = ^TGearArray;
 
    27 type PGearArray = ^TGearArray;
 
    28     TGearArray = record
 
    28     TGearArray = record
 
    29             ar: array[0..cMaxGearArrayInd] of PGear;
 
    29         ar: array[0..cMaxGearArrayInd] of PGear;
 
    30             Count: Longword
 
    30         Count: Longword
 
    31             end;
 
    31         end;
 
    32 
    32 
    33 procedure initModule;
 
    33 procedure initModule;
 
    34 procedure freeModule;
 
    34 procedure freeModule;
 
    35 
    35 
    36 procedure AddGearCI(Gear: PGear);
 
    36 procedure AddGearCI(Gear: PGear);
 
    58 
    58 
    59 implementation
 
    59 implementation
 
    60 uses uConsts, uLandGraphics, uVariables, uDebug, uGears, uGearsList;
 
    60 uses uConsts, uLandGraphics, uVariables, uDebug, uGears, uGearsList;
 
    61 
    61 
    62 type TCollisionEntry = record
 
    62 type TCollisionEntry = record
 
    63             X, Y, Radius: LongInt;
 
    63     X, Y, Radius: LongInt;
 
    64             cGear: PGear;
 
    64     cGear: PGear;
 
    65             end;
 
    65     end;
 
    66 
    66 
    67 const MAXRECTSINDEX = 1023;
 
    67 const MAXRECTSINDEX = 1023;
 
    68 var Count: Longword;
 
    68 var Count: Longword;
 
    69     cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
 
    69     cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
 
    70     ga: TGearArray;
 
    70     ga: TGearArray;
 
    71 
    71 
    72 procedure AddGearCI(Gear: PGear);
 
    72 procedure AddGearCI(Gear: PGear);
 
    73 var t: PGear;
 
    73 var t: PGear;
 
    74 begin
 
    74 begin
 
    75 if Gear^.CollisionIndex >= 0 then exit;
 
    75 if Gear^.CollisionIndex >= 0 then
 
       
    76     exit;
 
    76 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
 
    77 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
 
    77 with cinfos[Count] do
 
    78 with cinfos[Count] do
 
    78     begin
 
    79     begin
 
    79     X:= hwRound(Gear^.X);
 
    80     X:= hwRound(Gear^.X);
 
    80     Y:= hwRound(Gear^.Y);
 
    81     Y:= hwRound(Gear^.Y);
 
    88 if (Count > (MAXRECTSINDEX-20)) then
 
    89 if (Count > (MAXRECTSINDEX-20)) then
 
    89     begin
 
    90     begin
 
    90     t:= GearsList;
 
    91     t:= GearsList;
 
    91     while (t <> nil) and (t^.Kind <> gtMine) do 
    92     while (t <> nil) and (t^.Kind <> gtMine) do 
    92         t:= t^.NextGear;
 
    93         t:= t^.NextGear;
 
    93     if (t <> nil) then DeleteGear(t)
 
    94     if (t <> nil) then
 
       
    95         DeleteGear(t)
 
    94     end;
 
    96     end;
 
    95 end;
 
    97 end;
 
    96 
    98 
    97 procedure DeleteCI(Gear: PGear);
 
    99 procedure DeleteCI(Gear: PGear);
 
    98 begin
 
   100 begin
 
   111 var mx, my, tr: LongInt;
 
   113 var mx, my, tr: LongInt;
 
   112     i: Longword;
 
   114     i: Longword;
 
   113 begin
 
   115 begin
 
   114 CheckGearsCollision:= @ga;
 
   116 CheckGearsCollision:= @ga;
 
   115 ga.Count:= 0;
 
   117 ga.Count:= 0;
 
   116 if Count = 0 then exit;
 
   118 if Count = 0 then
 
       
   119     exit;
 
   117 mx:= hwRound(Gear^.X);
 
   120 mx:= hwRound(Gear^.X);
 
   118 my:= hwRound(Gear^.Y);
 
   121 my:= hwRound(Gear^.Y);
 
   119 
   122 
   120 tr:= Gear^.Radius + 2;
 
   123 tr:= Gear^.Radius + 2;
 
   121 
   124 
   132 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
 
   135 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
 
   133 var x, y, i: LongInt;
 
   136 var x, y, i: LongInt;
 
   134     TestWord: LongWord;
 
   137     TestWord: LongWord;
 
   135 begin
 
   138 begin
 
   136 if Gear^.IntersectGear <> nil then
 
   139 if Gear^.IntersectGear <> nil then
 
   137    with Gear^ do
 
   140     with Gear^ do
 
   138         if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X) - Radius) or
 
   141         if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X) - Radius)
 
   139            (hwRound(IntersectGear^.X) - IntersectGear^.Radius > hwRound(X) + Radius) then
 
   142         or (hwRound(IntersectGear^.X) - IntersectGear^.Radius > hwRound(X) + Radius) then
 
   140            begin
 
   143             begin
 
   141            IntersectGear:= nil;
 
   144             IntersectGear:= nil;
 
   142            TestWord:= 0
 
   145             TestWord:= 0
 
   143            end else
 
   146             end
 
   144            TestWord:= 255
 
   147         else
 
   145    else TestWord:= 0;
 
   148             TestWord:= 255
 
       
   149     else TestWord:= 0;
 
   146 
   150 
   147 x:= hwRound(Gear^.X);
 
   151 x:= hwRound(Gear^.X);
 
   148 if Dir < 0 then x:= x - Gear^.Radius
 
   152 if Dir < 0 then
 
   149            else x:= x + Gear^.Radius;
 
   153     x:= x - Gear^.Radius
 
       
   154 else
 
       
   155     x:= x + Gear^.Radius;
 
   150 if (x and LAND_WIDTH_MASK) = 0 then
 
   156 if (x and LAND_WIDTH_MASK) = 0 then
 
   151    begin
 
   157     begin
 
   152    y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   158     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   153    i:= y + Gear^.Radius * 2 - 2;
 
   159     i:= y + Gear^.Radius * 2 - 2;
 
   154    repeat
 
   160     repeat
 
   155      if (y and LAND_HEIGHT_MASK) = 0 then
 
   161         if (y and LAND_HEIGHT_MASK) = 0 then
 
   156         if Land[y, x] > TestWord then exit(true);
 
   162             if Land[y, x] > TestWord then
 
   157      inc(y)
 
   163                 exit(true);
 
   158    until (y > i);
 
   164         inc(y)
 
   159    end;
 
   165     until (y > i);
 
       
   166     end;
 
   160 TestCollisionXwithGear:= false
 
   167 TestCollisionXwithGear:= false
 
   161 end;
 
   168 end;
 
   162 
   169 
   163 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
 
   170 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
 
   164 var x, y, i: LongInt;
 
   171 var x, y, i: LongInt;
 
   165     TestWord: LongWord;
 
   172     TestWord: LongWord;
 
   166 begin
 
   173 begin
 
   167 if Gear^.IntersectGear <> nil then
 
   174 if Gear^.IntersectGear <> nil then
 
   168    with Gear^ do
 
   175     with Gear^ do
 
   169         if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y) - Radius) or
 
   176         if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y) - Radius) or
 
   170            (hwRound(IntersectGear^.Y) - IntersectGear^.Radius > hwRound(Y) + Radius) then
 
   177             (hwRound(IntersectGear^.Y) - IntersectGear^.Radius > hwRound(Y) + Radius) then
 
   171            begin
 
   178                 begin
 
   172            IntersectGear:= nil;
 
   179                 IntersectGear:= nil;
 
   173            TestWord:= 0
 
   180                 TestWord:= 0
 
   174            end else
 
   181                 end
 
   175            TestWord:= 255
 
   182         else
 
   176    else TestWord:= 0;
 
   183             TestWord:= 255
 
       
   184 else
 
       
   185     TestWord:= 0;
 
   177 
   186 
   178 y:= hwRound(Gear^.Y);
 
   187 y:= hwRound(Gear^.Y);
 
   179 if Dir < 0 then y:= y - Gear^.Radius
 
   188 if Dir < 0 then
 
   180            else y:= y + Gear^.Radius;
 
   189     y:= y - Gear^.Radius
 
       
   190 else
 
       
   191     y:= y + Gear^.Radius;
 
   181 if (y and LAND_HEIGHT_MASK) = 0 then
 
   192 if (y and LAND_HEIGHT_MASK) = 0 then
 
   182    begin
 
   193     begin
 
   183    x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   194     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   184    i:= x + Gear^.Radius * 2 - 2;
 
   195     i:= x + Gear^.Radius * 2 - 2;
 
   185    repeat
 
   196     repeat
 
   186      if (x and LAND_WIDTH_MASK) = 0 then
 
   197         if (x and LAND_WIDTH_MASK) = 0 then
 
   187         if Land[y, x] > TestWord then exit(Land[y, x]);
 
   198             if Land[y, x] > TestWord then
 
       
   199                 exit(Land[y, x]);
 
   188      inc(x)
 
   200      inc(x)
 
   189    until (x > i);
 
   201     until (x > i);
 
   190    end;
 
   202     end;
 
   191 TestCollisionYwithGear:= 0
 
   203 TestCollisionYwithGear:= 0
 
   192 end;
 
   204 end;
 
   193 
   205 
   194 function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
 
   206 function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
 
   195 var x, y, mx, my, i: LongInt;
 
   207 var x, y, mx, my, i: LongInt;
 
   196     flag: boolean;
 
   208     flag: boolean;
 
   197 begin
 
   209 begin
 
   198 flag:= false;
 
   210 flag:= false;
 
   199 x:= hwRound(Gear^.X);
 
   211 x:= hwRound(Gear^.X);
 
   200 if Dir < 0 then x:= x - Gear^.Radius
 
   212 if Dir < 0 then
 
   201            else x:= x + Gear^.Radius;
 
   213     x:= x - Gear^.Radius
 
       
   214 else
 
       
   215     x:= x + Gear^.Radius;
 
   202 if (x and LAND_WIDTH_MASK) = 0 then
 
   216 if (x and LAND_WIDTH_MASK) = 0 then
 
   203    begin
 
   217     begin
 
   204    y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   218     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   205    i:= y + Gear^.Radius * 2 - 2;
 
   219     i:= y + Gear^.Radius * 2 - 2;
 
   206    repeat
 
   220     repeat
 
   207      if (y and LAND_HEIGHT_MASK) = 0 then
 
   221         if (y and LAND_HEIGHT_MASK) = 0 then
 
   208            if Land[y, x] > 255 then exit(true)
 
   222             if Land[y, x] > 255 then
 
   209            else if Land[y, x] <> 0 then flag:= true;
 
   223                 exit(true)
 
   210      inc(y)
 
   224             else if Land[y, x] <> 0 then
 
   211    until (y > i);
 
   225                 flag:= true;
 
   212    end;
 
   226     inc(y)
 
       
   227     until (y > i);
 
       
   228     end;
 
   213 TestCollisionXKick:= flag;
 
   229 TestCollisionXKick:= flag;
 
   214 
   230 
   215 if flag then
 
   231 if flag then
 
   216    begin
 
   232     begin
 
   217    if hwAbs(Gear^.dX) < cHHKick then exit;
 
   233     if hwAbs(Gear^.dX) < cHHKick then
 
   218    if (Gear^.State and gstHHJumping <> 0)
 
   234         exit;
 
   219    and (hwAbs(Gear^.dX) < _0_4) then exit;
 
   235     if (Gear^.State and gstHHJumping <> 0)
 
   220 
   236     and (hwAbs(Gear^.dX) < _0_4) then
 
   221    mx:= hwRound(Gear^.X);
 
   237         exit;
 
   222    my:= hwRound(Gear^.Y);
 
   238 
   223 
   239     mx:= hwRound(Gear^.X);
 
   224    for i:= 0 to Pred(Count) do
 
   240     my:= hwRound(Gear^.Y);
 
   225     with cinfos[i] do
 
   241 
   226       if (Gear <> cGear) and
 
   242     for i:= 0 to Pred(Count) do
 
   227          (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
 
   243         with cinfos[i] do
 
   228          ((mx > x) xor (Dir > 0)) then
 
   244             if (Gear <> cGear) and (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2))
 
   229          if ((cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0)) or
 
   245             and ((mx > x) xor (Dir > 0)) then
 
   230             // only apply X kick if the barrel is knocked over
 
   246                 if ((cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0)) or
 
   231             ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0)) then
 
   247                 // only apply X kick if the barrel is knocked over
 
   232              begin
 
   248                 ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0)) then
 
   233              with cGear^ do
 
   249                     begin
 
   234                   begin
 
   250                     with cGear^ do
 
   235                   dX:= Gear^.dX;
 
   251                         begin
 
   236                   dY:= Gear^.dY * _0_5;
 
   252                         dX:= Gear^.dX;
 
   237                   State:= State or gstMoving;
 
   253                         dY:= Gear^.dY * _0_5;
 
   238                   Active:= true
 
   254                         State:= State or gstMoving;
 
   239                   end;
 
   255                         Active:= true
 
   240              DeleteCI(cGear);
 
   256                         end;
 
   241              exit(false)
 
   257                     DeleteCI(cGear);
 
   242              end
 
   258                     exit(false)
 
   243    end
 
   259                     end
 
       
   260     end
 
   244 end;
 
   261 end;
 
   245 
   262 
   246 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
 
   263 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
 
   247 var x, y, mx, my, i: LongInt;
 
   264 var x, y, mx, my, i: LongInt;
 
   248     flag: boolean;
 
   265     flag: boolean;
 
   249 begin
 
   266 begin
 
   250 flag:= false;
 
   267 flag:= false;
 
   251 y:= hwRound(Gear^.Y);
 
   268 y:= hwRound(Gear^.Y);
 
   252 if Dir < 0 then y:= y - Gear^.Radius
 
   269 if Dir < 0 then
 
   253            else y:= y + Gear^.Radius;
 
   270     y:= y - Gear^.Radius
 
       
   271 else
 
       
   272     y:= y + Gear^.Radius;
 
   254 if (y and LAND_HEIGHT_MASK) = 0 then
 
   273 if (y and LAND_HEIGHT_MASK) = 0 then
 
   255    begin
 
   274     begin
 
   256    x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   275     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   257    i:= x + Gear^.Radius * 2 - 2;
 
   276     i:= x + Gear^.Radius * 2 - 2;
 
   258    repeat
 
   277     repeat
 
   259      if (x and LAND_WIDTH_MASK) = 0 then
 
   278     if (x and LAND_WIDTH_MASK) = 0 then
 
   260         if Land[y, x] > 0 then
 
   279         if Land[y, x] > 0 then
 
   261            if Land[y, x] > 255 then exit(true)
 
   280             if Land[y, x] > 255 then
 
   262            else if Land[y, x] <> 0 then flag:= true;
 
   281                 exit(true)
 
   263      inc(x)
 
   282             else if Land[y, x] <> 0 then
 
   264    until (x > i);
 
   283                 flag:= true;
 
   265    end;
 
   284     inc(x)
 
       
   285     until (x > i);
 
       
   286     end;
 
   266 TestCollisionYKick:= flag;
 
   287 TestCollisionYKick:= flag;
 
   267 
   288 
   268 if flag then
 
   289 if flag then
 
   269    begin
 
   290     begin
 
   270    if hwAbs(Gear^.dY) < cHHKick then exit(true);
 
   291     if hwAbs(Gear^.dY) < cHHKick then
 
   271    if (Gear^.State and gstHHJumping <> 0)
 
   292         exit(true);
 
   272    and (not Gear^.dY.isNegative)
 
   293     if (Gear^.State and gstHHJumping <> 0)
 
   273    and (Gear^.dY < _0_4) then exit;
 
   294     and (not Gear^.dY.isNegative)
 
   274 
   295     and (Gear^.dY < _0_4) then
 
   275    mx:= hwRound(Gear^.X);
 
   296         exit;
 
   276    my:= hwRound(Gear^.Y);
 
   297 
   277 
   298     mx:= hwRound(Gear^.X);
 
   278    for i:= 0 to Pred(Count) do
 
   299     my:= hwRound(Gear^.Y);
 
   279     with cinfos[i] do
 
   300 
   280       if (Gear <> cGear) and
 
   301     for i:= 0 to Pred(Count) do
 
   281          (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
 
   302         with cinfos[i] do
 
   282          ((my > y) xor (Dir > 0)) then
 
   303             if (Gear <> cGear) and (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2))
 
   283          if (cGear^.Kind in [gtHedgehog, gtMine, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
 
   304             and ((my > y) xor (Dir > 0)) then
 
   284              begin
 
   305                 if (cGear^.Kind in [gtHedgehog, gtMine, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
 
   285              with cGear^ do
 
   306                     begin
 
   286                   begin
 
   307                     with cGear^ do
 
   287                   if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then dX:= Gear^.dX * _0_5;
 
   308                         begin
 
   288                   dY:= Gear^.dY;
 
   309                         if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then
 
   289                   State:= State or gstMoving;
 
   310                             dX:= Gear^.dX * _0_5;
 
   290                   Active:= true
 
   311                         dY:= Gear^.dY;
 
   291                   end;
 
   312                         State:= State or gstMoving;
 
   292              DeleteCI(cGear);
 
   313                         Active:= true
 
   293              exit(false)
 
   314                         end;
 
   294              end
 
   315                     DeleteCI(cGear);
 
   295    end
 
   316                     exit(false)
 
       
   317                     end
 
       
   318     end
 
   296 end;
 
   319 end;
 
   297 
   320 
   298 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
 
   321 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
 
   299 begin
 
   322 begin
 
   300 Gear^.X:= Gear^.X + ShiftX;
 
   323 Gear^.X:= Gear^.X + ShiftX;
 
   307 end;
 
   330 end;
 
   308 function TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
 
   331 function TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
 
   309 var x, y, i: LongInt;
 
   332 var x, y, i: LongInt;
 
   310 begin
 
   333 begin
 
   311 x:= hwRound(Gear^.X);
 
   334 x:= hwRound(Gear^.X);
 
   312 if Dir < 0 then x:= x - Gear^.Radius
 
   335 if Dir < 0 then
 
   313            else x:= x + Gear^.Radius;
 
   336     x:= x - Gear^.Radius
 
       
   337 else
 
       
   338     x:= x + Gear^.Radius;
 
   314 if (x and LAND_WIDTH_MASK) = 0 then
 
   339 if (x and LAND_WIDTH_MASK) = 0 then
 
   315    begin
 
   340     begin
 
   316    y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   341     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   317    i:= y + Gear^.Radius * 2 - 2;
 
   342     i:= y + Gear^.Radius * 2 - 2;
 
   318    repeat
 
   343     repeat
 
   319      if (y and LAND_HEIGHT_MASK) = 0 then
 
   344         if (y and LAND_HEIGHT_MASK) = 0 then
 
   320         if Land[y, x] > 255 then exit(true);
 
   345             if Land[y, x] > 255 then
 
   321      inc(y)
 
   346                 exit(true);
 
   322    until (y > i);
 
   347     inc(y)
 
   323    end;
 
   348     until (y > i);
 
       
   349     end;
 
   324 TestCollisionX:= false
 
   350 TestCollisionX:= false
 
   325 end;
 
   351 end;
 
   326 
   352 
   327 function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
 
   353 function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
 
   328 var x, y, i: LongInt;
 
   354 var x, y, i: LongInt;
 
   329 begin
 
   355 begin
 
   330 y:= hwRound(Gear^.Y);
 
   356 y:= hwRound(Gear^.Y);
 
   331 if Dir < 0 then y:= y - Gear^.Radius
 
   357 if Dir < 0 then
 
   332            else y:= y + Gear^.Radius;
 
   358     y:= y - Gear^.Radius
 
       
   359 else
 
       
   360     y:= y + Gear^.Radius;
 
   333 if (y and LAND_HEIGHT_MASK) = 0 then
 
   361 if (y and LAND_HEIGHT_MASK) = 0 then
 
   334    begin
 
   362     begin
 
   335    x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   363     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   336    i:= x + Gear^.Radius * 2 - 2;
 
   364     i:= x + Gear^.Radius * 2 - 2;
 
   337    repeat
 
   365     repeat
 
   338      if (x and LAND_WIDTH_MASK) = 0 then
 
   366         if (x and LAND_WIDTH_MASK) = 0 then
 
   339         if Land[y, x] > 255 then exit(true);
 
   367             if Land[y, x] > 255 then
 
   340      inc(x)
 
   368                 exit(true);
 
   341    until (x > i);
 
   369     inc(x)
 
   342    end;
 
   370     until (x > i);
 
       
   371     end;
 
   343 TestCollisionY:= false
 
   372 TestCollisionY:= false
 
   344 end;
 
   373 end;
 
   345 
   374 
   346 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
 
   375 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean = true): boolean;
 
   347 begin
 
   376 begin
 
   348 Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
 
   377 Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
 
   349 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
 
   378 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
 
   350 if withGear then TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir) <> 0
 
   379 
   351 else TestCollisionYwithXYShift:= TestCollisionY(Gear, Dir);
 
   380 if withGear then
 
       
   381   TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir) <> 0
 
       
   382 else
 
       
   383   TestCollisionYwithXYShift:= TestCollisionY(Gear, Dir);
 
       
   384   
   352 Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
 
   385 Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
 
   353 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
 
   386 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
 
   354 end;
 
   387 end;
 
   355 
   388 
   356 function TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
 
   389 function TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
 
   361     TestWord:= 255
 
   394     TestWord:= 255
 
   362 else
 
   395 else
 
   363     TestWord:= 0;
 
   396     TestWord:= 0;
 
   364 
   397 
   365 if x1 > x2 then
 
   398 if x1 > x2 then
 
   366 begin
 
   399     begin
 
   367     x  := x1;
 
   400     x  := x1;
 
   368     x1 := x2;
 
   401     x1 := x2;
 
   369     x2 := x;
 
   402     x2 := x;
 
   370 end;
 
   403   end;
 
   371 
   404 
   372 if y1 > y2 then
 
   405 if y1 > y2 then
 
   373 begin
 
   406     begin
 
   374     y  := y1;
 
   407     y  := y1;
 
   375     y1 := y2;
 
   408     y1 := y2;
 
   376     y2 := y;
 
   409     y2 := y;
 
   377 end;
 
   410   end;
 
   378 
   411 
   379 if (hasBorder and ((y1 < 0) or (x1 < 0) or (x2 > LAND_WIDTH))) then
 
   412 if (hasBorder and ((y1 < 0) or (x1 < 0) or (x2 > LAND_WIDTH))) then
 
   380     exit(true);
 
   413     exit(true);
 
   381 
   414 
   382 for y := y1 to y2 do
 
   415 for y := y1 to y2 do
 
   383     for x := x1 to x2 do
 
   416     for x := x1 to x2 do
 
   384         if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0)
 
   417         if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0)
 
   385           and (Land[y, x] > TestWord) then
 
   418         and (Land[y, x] > TestWord) then
 
   386             exit(true);
 
   419             exit(true);
 
   387 
   420 
   388 TestRectancleForObstacle:= false
 
   421 TestRectancleForObstacle:= false
 
   389 end;
 
   422 end;
 
   390 
   423 
   440                             li:= i;
 
   473                             li:= i;
 
   441                         end;
 
   474                         end;
 
   442                     end;
 
   475                     end;
 
   443             end;
 
   476             end;
 
   444 
   477 
   445         if i = 7 then break;
 
   478         if i = 7 then
 
       
   479             break;
 
   446 
   480 
   447         // prepare offset for next check (clockwise)
 
   481         // prepare offset for next check (clockwise)
 
   448         if (mx = -1) and (my <> -1) then my:= my - 1
 
   482         if (mx = -1) and (my <> -1) then
 
   449         else if (my = -1) and (mx <> 1) then mx:= mx + 1
 
   483             my:= my - 1
 
   450         else if (mx = 1) and (my <> 1) then my:= my + 1
 
   484         else if (my = -1) and (mx <> 1) then
 
   451         else mx:= mx - 1;
 
   485             mx:= mx + 1
 
       
   486         else if (mx = 1) and (my <> 1) then
 
       
   487             my:= my + 1
 
       
   488         else
 
       
   489             mx:= mx - 1;
 
   452 
   490 
   453         end;
 
   491         end;
 
   454 
   492 
   455     ldx:= collisionX;
 
   493     ldx:= collisionX;
 
   456     ldy:= collisionY;
 
   494     ldy:= collisionY;
 
   473             for k:= 3 downto 1 do
 
   511             for k:= 3 downto 1 do
 
   474                 begin
 
   512                 begin
 
   475                 tmpx:= ldx + k * offset[tmpo,0];
 
   513                 tmpx:= ldx + k * offset[tmpo,0];
 
   476                 tmpy:= ldy + k * offset[tmpo,1];
 
   514                 tmpy:= ldy + k * offset[tmpo,1];
 
   477                 if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
 
   515                 if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
 
   478                     and (Land[tmpy,tmpx] > TestWord) then
 
   516                 and (Land[tmpy,tmpx] > TestWord) then
 
   479                         begin
 
   517                     begin
 
   480                         ldx:= tmpx;
 
   518                     ldx:= tmpx;
 
   481                         ldy:= tmpy;
 
   519                     ldy:= tmpy;
 
   482                         isColl:= true;
 
   520                     isColl:= true;
 
   483                         break;
 
   521                     break;
 
   484                         end;
 
   522                     end;
 
   485                 end;
 
   523                 end;
 
   486             if isColl then break;
 
   524             if isColl then
 
       
   525                 break;
 
   487             end;
 
   526             end;
 
   488 
   527 
   489         jfr:= 8+ri-1;
 
   528         jfr:= 8+ri-1;
 
   490         jto:= 8+ri+1;
 
   529         jto:= 8+ri+1;
 
   491 
   530 
   496             for k:= 3 downto 1 do
 
   535             for k:= 3 downto 1 do
 
   497                 begin
 
   536                 begin
 
   498                 tmpx:= rdx + k * offset[tmpo,0];
 
   537                 tmpx:= rdx + k * offset[tmpo,0];
 
   499                 tmpy:= rdy + k * offset[tmpo,1];
 
   538                 tmpy:= rdy + k * offset[tmpo,1];
 
   500                 if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
 
   539                 if (((tmpy) and LAND_HEIGHT_MASK) = 0) and (((tmpx) and LAND_WIDTH_MASK)  = 0)
 
   501                     and (Land[tmpy,tmpx] > TestWord) then
 
   540                 and (Land[tmpy,tmpx] > TestWord) then
 
   502                         begin
 
   541                     begin
 
   503                         rdx:= tmpx;
 
   542                     rdx:= tmpx;
 
   504                         rdy:= tmpy;
 
   543                     rdy:= tmpy;
 
   505                         isColl:= true;
 
   544                     isColl:= true;
 
   506                         break;
 
   545                     break;
 
   507                         end;
 
   546                     end;
 
   508                 end;
 
   547                 end;
 
   509             if isColl then break;
 
   548             if isColl then
 
       
   549                 break;
 
   510             end;
 
   550             end;
 
   511         end;
 
   551         end;
 
   512 
   552 
   513     ldx:= rdx - ldx;
 
   553     ldx:= rdx - ldx;
 
   514     ldy:= rdy - ldy;
 
   554     ldy:= rdy - ldy;
 
   515 
   555 
   516     if ((ldx = 0) and (ldy = 0)) then EXIT(false);
 
   556     if ((ldx = 0) and (ldy = 0)) then
 
       
   557         EXIT(false);
 
   517 
   558 
   518 outDeltaX:= ldx;
 
   559 outDeltaX:= ldx;
 
   519 outDeltaY:= ldy;
 
   560 outDeltaY:= ldy;
 
   520 exit(true);
 
   561 exit(true);
 
   521 end;
 
   562 end;
 
   531 gx:= hwRound(Gear^.X);
 
   572 gx:= hwRound(Gear^.X);
 
   532 collX := gx;
 
   573 collX := gx;
 
   533 isColl:= false;
 
   574 isColl:= false;
 
   534 
   575 
   535 if (y and LAND_HEIGHT_MASK) = 0 then
 
   576 if (y and LAND_HEIGHT_MASK) = 0 then
 
   536    begin
 
   577     begin
 
   537    x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   578     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   538    i:= x + Gear^.Radius * 2 - 2;
 
   579     i:= x + Gear^.Radius * 2 - 2;
 
   539    repeat
 
   580     repeat
 
   540      if (x and LAND_WIDTH_MASK) = 0 then
 
   581     if (x and LAND_WIDTH_MASK) = 0 then
 
   541         if Land[y, x] > 255 then
 
   582         if Land[y, x] > 255 then
 
   542             if not isColl or (abs(x-gx) < abs(collX-gx)) then
 
   583             if not isColl or (abs(x-gx) < abs(collX-gx)) then
 
   543                 begin
 
   584                 begin
 
   544                 isColl:= true;
 
   585                 isColl:= true;
 
   545                 collX := x;
 
   586                 collX := x;
 
   546                 end;
 
   587                 end;
 
   547      inc(x)
 
   588     inc(x)
 
   548    until (x > i);
 
   589     until (x > i);
 
   549    end;
 
   590     end;
 
   550 
   591 
   551 if isColl then
 
   592 if isColl then
 
   552     begin
 
   593     begin
 
   553     // save original dx/dy
 
   594     // save original dx/dy
 
   554     dx := Gear^.dX;
 
   595     dx := Gear^.dX;
hedgewars