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 6990 40e5af28d026
parent 6986 409dd3851309
child 6992 b8f3d8991e92
equal deleted inserted replaced
6989:4c35e9cf6057 6990:40e5af28d026 
   153 x:= hwRound(Gear^.X);
 
   153 x:= hwRound(Gear^.X);
 
   154 if Dir < 0 then
 
   154 if Dir < 0 then
 
   155     x:= x - Gear^.Radius
 
   155     x:= x - Gear^.Radius
 
   156 else
 
   156 else
 
   157     x:= x + Gear^.Radius;
 
   157     x:= x + Gear^.Radius;
 
       
   158 
       
   159 TestCollisionXwithGear:= true;
 
   158 if (x and LAND_WIDTH_MASK) = 0 then
 
   160 if (x and LAND_WIDTH_MASK) = 0 then
 
   159     begin
 
   161     begin
 
   160     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   162     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   161     i:= y + Gear^.Radius * 2 - 2;
 
   163     i:= y + Gear^.Radius * 2 - 2;
 
   162     repeat
 
   164     repeat
 
   163         if (y and LAND_HEIGHT_MASK) = 0 then
 
   165         if (y and LAND_HEIGHT_MASK) = 0 then
 
   164             if Land[y, x] > TestWord then
 
   166             if Land[y, x] > TestWord then
 
   165                 exit(true);
 
   167                 exit;
 
   166         inc(y)
 
   168         inc(y)
 
   167     until (y > i);
 
   169     until (y > i);
 
   168     end;
 
   170     end;
 
   169 TestCollisionXwithGear:= false
 
   171 TestCollisionXwithGear:= false
 
   170 end;
 
   172 end;
 
   196     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   198     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   197     i:= x + Gear^.Radius * 2 - 2;
 
   199     i:= x + Gear^.Radius * 2 - 2;
 
   198     repeat
 
   200     repeat
 
   199         if (x and LAND_WIDTH_MASK) = 0 then
 
   201         if (x and LAND_WIDTH_MASK) = 0 then
 
   200             if Land[y, x] > TestWord then
 
   202             if Land[y, x] > TestWord then
 
   201                 exit(Land[y, x]);
 
   203             begin
 
       
   204                 TestCollisionYwithGear:= Land[y, x];
 
       
   205                 exit;
 
       
   206             end;
 
   202      inc(x)
 
   207      inc(x)
 
   203     until (x > i);
 
   208     until (x > i);
 
   204     end;
 
   209     end;
 
   205 TestCollisionYwithGear:= 0
 
   210 TestCollisionYwithGear:= 0
 
   206 end;
 
   211 end;
 
   213 x:= hwRound(Gear^.X);
 
   218 x:= hwRound(Gear^.X);
 
   214 if Dir < 0 then
 
   219 if Dir < 0 then
 
   215     x:= x - Gear^.Radius
 
   220     x:= x - Gear^.Radius
 
   216 else
 
   221 else
 
   217     x:= x + Gear^.Radius;
 
   222     x:= x + Gear^.Radius;
 
       
   223 
       
   224 TestCollisionXKick:= true;
 
   218 if (x and LAND_WIDTH_MASK) = 0 then
 
   225 if (x and LAND_WIDTH_MASK) = 0 then
 
   219     begin
 
   226     begin
 
   220     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   227     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   221     i:= y + Gear^.Radius * 2 - 2;
 
   228     i:= y + Gear^.Radius * 2 - 2;
 
   222     repeat
 
   229     repeat
 
   223         if (y and LAND_HEIGHT_MASK) = 0 then
 
   230         if (y and LAND_HEIGHT_MASK) = 0 then
 
   224             if Land[y, x] > 255 then
 
   231             if Land[y, x] > 255 then
 
   225                 exit(true)
 
   232                 exit
 
   226             else if Land[y, x] <> 0 then
 
   233             else if Land[y, x] <> 0 then
 
   227                 flag:= true;
 
   234                 flag:= true;
 
   228     inc(y)
 
   235     inc(y)
 
   229     until (y > i);
 
   236     until (y > i);
 
   230     end;
 
   237     end;
 
   255                         dY:= Gear^.dY * _0_5;
 
   262                         dY:= Gear^.dY * _0_5;
 
   256                         State:= State or gstMoving;
 
   263                         State:= State or gstMoving;
 
   257                         Active:= true
 
   264                         Active:= true
 
   258                         end;
 
   265                         end;
 
   259                     DeleteCI(cGear);
 
   266                     DeleteCI(cGear);
 
   260                     exit(false)
 
   267                     TestCollisionXKick:= false;
 
       
   268                     exit;
 
   261                     end
 
   269                     end
 
   262     end
 
   270     end
 
   263 end;
 
   271 end;
 
   264 
   272 
   265 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
 
   273 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
 
   270 y:= hwRound(Gear^.Y);
 
   278 y:= hwRound(Gear^.Y);
 
   271 if Dir < 0 then
 
   279 if Dir < 0 then
 
   272     y:= y - Gear^.Radius
 
   280     y:= y - Gear^.Radius
 
   273 else
 
   281 else
 
   274     y:= y + Gear^.Radius;
 
   282     y:= y + Gear^.Radius;
 
       
   283 
       
   284 TestCollisionYKick:= true;
 
   275 if (y and LAND_HEIGHT_MASK) = 0 then
 
   285 if (y and LAND_HEIGHT_MASK) = 0 then
 
   276     begin
 
   286     begin
 
   277     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   287     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   278     i:= x + Gear^.Radius * 2 - 2;
 
   288     i:= x + Gear^.Radius * 2 - 2;
 
   279     repeat
 
   289     repeat
 
   280     if (x and LAND_WIDTH_MASK) = 0 then
 
   290     if (x and LAND_WIDTH_MASK) = 0 then
 
   281         if Land[y, x] > 0 then
 
   291         if Land[y, x] > 0 then
 
   282             if Land[y, x] > 255 then
 
   292             if Land[y, x] > 255 then
 
   283                 exit(true)
 
   293                 exit
 
   284             else if Land[y, x] <> 0 then
 
   294             else if Land[y, x] <> 0 then
 
   285                 flag:= true;
 
   295                 flag:= true;
 
   286     inc(x)
 
   296     inc(x)
 
   287     until (x > i);
 
   297     until (x > i);
 
   288     end;
 
   298     end;
 
   289 TestCollisionYKick:= flag;
 
   299 TestCollisionYKick:= flag;
 
   290 
   300 
   291 if flag then
 
   301 if flag then
 
   292     begin
 
   302     begin
 
   293     if hwAbs(Gear^.dY) < cHHKick then
 
   303     if hwAbs(Gear^.dY) < cHHKick then
 
   294         exit(true);
 
   304         exit;
 
   295     if (Gear^.State and gstHHJumping <> 0)
 
   305     if (Gear^.State and gstHHJumping <> 0) and (not Gear^.dY.isNegative) and (Gear^.dY < _0_4) then
 
   296     and (not Gear^.dY.isNegative)
 
       
   297     and (Gear^.dY < _0_4) then
 
       
   298         exit;
 
   306         exit;
 
   299 
   307 
   300     mx:= hwRound(Gear^.X);
 
   308     mx:= hwRound(Gear^.X);
 
   301     my:= hwRound(Gear^.Y);
 
   309     my:= hwRound(Gear^.Y);
 
   302 
   310 
   313                         dY:= Gear^.dY;
 
   321                         dY:= Gear^.dY;
 
   314                         State:= State or gstMoving;
 
   322                         State:= State or gstMoving;
 
   315                         Active:= true
 
   323                         Active:= true
 
   316                         end;
 
   324                         end;
 
   317                     DeleteCI(cGear);
 
   325                     DeleteCI(cGear);
 
   318                     exit(false)
 
   326                     TestCollisionYKick:= false;
 
       
   327                     exit
 
   319                     end
 
   328                     end
 
   320     end
 
   329     end
 
   321 end;
 
   330 end;
 
   322 
   331 
   323 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean; inline;
 
   332 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean; inline;
 
   333     TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir)
 
   342     TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir)
 
   334 else TestCollisionXwithXYShift:= TestCollisionX(Gear, Dir);
 
   343 else TestCollisionXwithXYShift:= TestCollisionX(Gear, Dir);
 
   335 Gear^.X:= Gear^.X - ShiftX;
 
   344 Gear^.X:= Gear^.X - ShiftX;
 
   336 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
 
   345 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
 
   337 end;
 
   346 end;
 
       
   347 
   338 function TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
 
   348 function TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
 
   339 var x, y, i: LongInt;
 
   349 var x, y, i: LongInt;
 
   340 begin
 
   350 begin
 
   341 x:= hwRound(Gear^.X);
 
   351 x:= hwRound(Gear^.X);
 
   342 if Dir < 0 then
 
   352 if Dir < 0 then
 
   343     x:= x - Gear^.Radius
 
   353     x:= x - Gear^.Radius
 
   344 else
 
   354 else
 
   345     x:= x + Gear^.Radius;
 
   355     x:= x + Gear^.Radius;
 
       
   356 
       
   357 TestCollisionX:= true;
 
   346 if (x and LAND_WIDTH_MASK) = 0 then
 
   358 if (x and LAND_WIDTH_MASK) = 0 then
 
   347     begin
 
   359     begin
 
   348     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   360     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
 
   349     i:= y + Gear^.Radius * 2 - 2;
 
   361     i:= y + Gear^.Radius * 2 - 2;
 
   350     repeat
 
   362     repeat
 
   351         if (y and LAND_HEIGHT_MASK) = 0 then
 
   363         if (y and LAND_HEIGHT_MASK) = 0 then
 
   352             if Land[y, x] > 255 then
 
   364             if Land[y, x] > 255 then
 
   353                 exit(true);
 
   365                 exit;
 
   354     inc(y)
 
   366     inc(y)
 
   355     until (y > i);
 
   367     until (y > i);
 
   356     end;
 
   368     end;
 
   357 TestCollisionX:= false
 
   369 TestCollisionX:= false
 
   358 end;
 
   370 end;
 
   363 y:= hwRound(Gear^.Y);
 
   375 y:= hwRound(Gear^.Y);
 
   364 if Dir < 0 then
 
   376 if Dir < 0 then
 
   365     y:= y - Gear^.Radius
 
   377     y:= y - Gear^.Radius
 
   366 else
 
   378 else
 
   367     y:= y + Gear^.Radius;
 
   379     y:= y + Gear^.Radius;
 
       
   380 
       
   381 TestCollisionY:= true;
 
   368 if (y and LAND_HEIGHT_MASK) = 0 then
 
   382 if (y and LAND_HEIGHT_MASK) = 0 then
 
   369     begin
 
   383     begin
 
   370     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   384     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
 
   371     i:= x + Gear^.Radius * 2 - 2;
 
   385     i:= x + Gear^.Radius * 2 - 2;
 
   372     repeat
 
   386     repeat
 
   373         if (x and LAND_WIDTH_MASK) = 0 then
 
   387         if (x and LAND_WIDTH_MASK) = 0 then
 
   374             if Land[y, x] > 255 then
 
   388             if Land[y, x] > 255 then
 
   375                 exit(true);
 
   389                 exit;
 
   376     inc(x)
 
   390     inc(x)
 
   377     until (x > i);
 
   391     until (x > i);
 
   378     end;
 
   392     end;
 
   379 TestCollisionY:= false
 
   393 TestCollisionY:= false
 
   380 end;
 
   394 end;
 
   400 
   414 
   401 function TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
 
   415 function TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
 
   402 var x, y: LongInt;
 
   416 var x, y: LongInt;
 
   403     TestWord: LongWord;
 
   417     TestWord: LongWord;
 
   404 begin
 
   418 begin
 
       
   419 TestRectancleForObstacle:= true;
 
       
   420 
   405 if landOnly then
 
   421 if landOnly then
 
   406     TestWord:= 255
 
   422     TestWord:= 255
 
   407 else
 
   423 else
 
   408     TestWord:= 0;
 
   424     TestWord:= 0;
 
   409 
   425 
   410 if x1 > x2 then
 
   426 if x1 > x2 then
 
   411     begin
 
   427 begin
 
   412     x  := x1;
 
   428     x  := x1;
 
   413     x1 := x2;
 
   429     x1 := x2;
 
   414     x2 := x;
 
   430     x2 := x;
 
   415   end;
 
   431 end;
 
   416 
   432 
   417 if y1 > y2 then
 
   433 if y1 > y2 then
 
   418     begin
 
   434 begin
 
   419     y  := y1;
 
   435     y  := y1;
 
   420     y1 := y2;
 
   436     y1 := y2;
 
   421     y2 := y;
 
   437     y2 := y;
 
   422   end;
 
   438 end;
 
   423 
   439 
   424 if (hasBorder and ((y1 < 0) or (x1 < 0) or (x2 > LAND_WIDTH))) then
 
   440 if (hasBorder and ((y1 < 0) or (x1 < 0) or (x2 > LAND_WIDTH))) then
 
   425     exit(true);
 
   441     exit;
 
   426 
   442 
   427 for y := y1 to y2 do
 
   443 for y := y1 to y2 do
 
   428     for x := x1 to x2 do
 
   444     for x := x1 to x2 do
 
   429         if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0)
 
   445         if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0) and (Land[y, x] > TestWord) then
 
   430         and (Land[y, x] > TestWord) then
 
   446             exit;
 
   431             exit(true);
 
       
   432 
   447 
   433 TestRectancleForObstacle:= false
 
   448 TestRectancleForObstacle:= false
 
   434 end;
 
   449 end;
 
   435 
   450 
   436 function CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean;
 
   451 function CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean;
 
   440     dx, dy, s: hwFloat;
 
   455     dx, dy, s: hwFloat;
 
   441     offset: array[0..7,0..1] of ShortInt;
 
   456     offset: array[0..7,0..1] of ShortInt;
 
   442     isColl: Boolean;
 
   457     isColl: Boolean;
 
   443 
   458 
   444 begin
 
   459 begin
 
       
   460     CalcSlopeTangent:= false;
 
       
   461 
   445     dx:= Gear^.dX;
 
   462     dx:= Gear^.dX;
 
   446     dy:= Gear^.dY;
 
   463     dy:= Gear^.dY;
 
   447 
   464 
   448     // we start searching from the direction the gear came from
 
   465     // we start searching from the direction the gear came from
 
   449     if (dx.QWordValue > _0_995.QWordValue )
 
   466     if (dx.QWordValue > _0_995.QWordValue )
 
   564 
   581 
   565     ldx:= rdx - ldx;
 
   582     ldx:= rdx - ldx;
 
   566     ldy:= rdy - ldy;
 
   583     ldy:= rdy - ldy;
 
   567 
   584 
   568     if ((ldx = 0) and (ldy = 0)) then
 
   585     if ((ldx = 0) and (ldy = 0)) then
 
   569         EXIT(false);
 
   586         exit;
 
   570 
   587 
   571 outDeltaX:= ldx;
 
   588 outDeltaX:= ldx;
 
   572 outDeltaY:= ldy;
 
   589 outDeltaY:= ldy;
 
   573 exit(true);
 
   590 CalcSlopeTangent:= true;
 
   574 end;
 
   591 end;
 
   575 
   592 
   576 function CalcSlopeBelowGear(Gear: PGear): hwFloat;
 
   593 function CalcSlopeBelowGear(Gear: PGear): hwFloat;
 
   577 var dx, dy: hwFloat;
 
   594 var dx, dy: hwFloat;
 
   578     collX, i, y, x, gx, sdx, sdy: LongInt;
 
   595     collX, i, y, x, gx, sdx, sdy: LongInt;
hedgewars