hedgewars/uCollisions.pas
branchwebgl
changeset 9950 2759212a27de
parent 9521 8054d9d775fd
parent 9737 f0769402350c
child 10015 4feced261c68
equal deleted inserted replaced
9521:8054d9d775fd 9950:2759212a27de
    36 procedure AddCI(Gear: PGear);
    36 procedure AddCI(Gear: PGear);
    37 procedure DeleteCI(Gear: PGear);
    37 procedure DeleteCI(Gear: PGear);
    38 
    38 
    39 function  CheckGearsCollision(Gear: PGear): PGearArray;
    39 function  CheckGearsCollision(Gear: PGear): PGearArray;
    40 
    40 
    41 function  TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
    41 function  TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
    42 function  TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
    42 function  TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
    43 
    43 
    44 function  TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
    44 function  TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
    45 function  TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
    45 function  TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;
    46 
    46 
    47 function  TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
    47 function  TestCollisionX(Gear: PGear; Dir: LongInt): Word;
    48 function  TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
    48 function  TestCollisionY(Gear: PGear; Dir: LongInt): Word;
    49 
    49 
    50 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean; inline;
    50 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
    51 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): boolean;
    51 function  TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
    52 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean; inline;
    52 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
    53 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): boolean;
    53 function  TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
    54 
    54 
    55 function  TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
    55 function  TestRectancleForObstacle(x1, y1, x2, y2: LongInt; landOnly: boolean): boolean;
    56 
    56 
    57 // returns: negative sign if going downhill to left, value is steepness (noslope/error = _0, 45 = _0_5)
    57 // returns: negative sign if going downhill to left, value is steepness (noslope/error = _0, 45 = _0_5)
    58 function  CalcSlopeBelowGear(Gear: PGear): hwFloat;
    58 function  CalcSlopeBelowGear(Gear: PGear): hwFloat;
    59 function  CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat;
    59 function  CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat;
    60 function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): Boolean;
    60 function  CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean;
    61 
    61 
    62 implementation
    62 implementation
    63 uses uConsts, uLandGraphics, uVariables, uDebug, uGearsList;
    63 uses uConsts, uLandGraphics, uVariables, uDebug;
    64 
    64 
    65 type TCollisionEntry = record
    65 type TCollisionEntry = record
    66     X, Y, Radius: LongInt;
    66     X, Y, Radius: LongInt;
    67     cGear: PGear;
    67     cGear: PGear;
    68     end;
    68     end;
    93     begin
    93     begin
    94     t:= GearsList;
    94     t:= GearsList;
    95     while (t <> nil) and (t^.Kind <> gtMine) do 
    95     while (t <> nil) and (t^.Kind <> gtMine) do 
    96         t:= t^.NextGear;
    96         t:= t^.NextGear;
    97     if (t <> nil) then
    97     if (t <> nil) then
    98         DeleteGear(t)
    98         t^.State:= t^.State or gmDelete
    99     end;
    99     end;
   100 end;
   100 end;
   101 
   101 
   102 procedure DeleteCI(Gear: PGear);
   102 procedure DeleteCI(Gear: PGear);
   103 begin
   103 begin
   133                 ga.ar[ga.Count]:= cinfos[i].cGear;
   133                 ga.ar[ga.Count]:= cinfos[i].cGear;
   134                 inc(ga.Count)
   134                 inc(ga.Count)
   135                 end
   135                 end
   136 end;
   136 end;
   137 
   137 
   138 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   138 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
   139 var x, y, i: LongInt;
   139 var x, y, i: LongInt;
   140 begin
   140 begin
   141 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   141 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   142 if (Gear^.CollisionMask = lfNotCurrentMask) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   142 if (Gear^.CollisionMask = lfNotCurrentMask) and (Gear^.Kind <> gtHedgehog) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   143     ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.X) - Gear^.Radius) or
   143     ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 16 < hwRound(Gear^.X) - Gear^.Radius) or
   148 if Dir < 0 then
   148 if Dir < 0 then
   149     x:= x - Gear^.Radius
   149     x:= x - Gear^.Radius
   150 else
   150 else
   151     x:= x + Gear^.Radius;
   151     x:= x + Gear^.Radius;
   152 
   152 
   153 TestCollisionXwithGear:= true;
       
   154 if (x and LAND_WIDTH_MASK) = 0 then
   153 if (x and LAND_WIDTH_MASK) = 0 then
   155     begin
   154     begin
   156     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   155     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   157     i:= y + Gear^.Radius * 2 - 2;
   156     i:= y + Gear^.Radius * 2 - 2;
   158     repeat
   157     repeat
   159         if (y and LAND_HEIGHT_MASK) = 0 then
   158         if (y and LAND_HEIGHT_MASK) = 0 then
   160             if Land[y, x] and Gear^.CollisionMask <> 0 then
   159             if Land[y, x] and Gear^.CollisionMask <> 0 then
   161                 exit;
   160                 exit(Land[y, x] and Gear^.CollisionMask);
   162         inc(y)
   161         inc(y)
   163     until (y > i);
   162     until (y > i);
   164     end;
   163     end;
   165 TestCollisionXwithGear:= false
   164 TestCollisionXwithGear:= 0
   166 end;
   165 end;
   167 
   166 
   168 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
   167 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
   169 var x, y, i: LongInt;
   168 var x, y, i: LongInt;
   170 begin
   169 begin
   186     i:= x + Gear^.Radius * 2 - 2;
   185     i:= x + Gear^.Radius * 2 - 2;
   187     repeat
   186     repeat
   188         if (x and LAND_WIDTH_MASK) = 0 then
   187         if (x and LAND_WIDTH_MASK) = 0 then
   189             if Land[y, x] and Gear^.CollisionMask <> 0 then
   188             if Land[y, x] and Gear^.CollisionMask <> 0 then
   190                 begin
   189                 begin
   191                 TestCollisionYwithGear:= Land[y, x];
   190                 exit(Land[y, x] and Gear^.CollisionMask)
   192                 exit;
       
   193                 end;
   191                 end;
   194         inc(x)
   192         inc(x)
   195     until (x > i);
   193     until (x > i);
   196     end;
   194     end;
   197 TestCollisionYwithGear:= 0
   195 TestCollisionYwithGear:= 0
   198 end;
   196 end;
   199 
   197 
   200 function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
   198 function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word;
   201 var x, y, mx, my, i: LongInt;
   199 var x, y, mx, my, i: LongInt;
   202     flag: boolean;
   200     pixel: Word;
   203 begin
   201 begin
   204 flag:= false;
   202 pixel:= 0;
   205 x:= hwRound(Gear^.X);
   203 x:= hwRound(Gear^.X);
   206 if Dir < 0 then
   204 if Dir < 0 then
   207     x:= x - Gear^.Radius
   205     x:= x - Gear^.Radius
   208 else
   206 else
   209     x:= x + Gear^.Radius;
   207     x:= x + Gear^.Radius;
   210 
   208 
   211 TestCollisionXKick:= true;
       
   212 if (x and LAND_WIDTH_MASK) = 0 then
   209 if (x and LAND_WIDTH_MASK) = 0 then
   213     begin
   210     begin
   214     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   211     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   215     i:= y + Gear^.Radius * 2 - 2;
   212     i:= y + Gear^.Radius * 2 - 2;
   216     repeat
   213     repeat
   217         if (y and LAND_HEIGHT_MASK) = 0 then
   214         if (y and LAND_HEIGHT_MASK) = 0 then
   218             if Land[y, x] > 255 then
   215             if Land[y, x] and Gear^.CollisionMask > 255 then
   219                 exit
   216                 exit(Land[y, x] and Gear^.CollisionMask)
   220             else if Land[y, x] <> 0 then
   217             else if Land[y, x] and Gear^.CollisionMask <> 0 then
   221                 flag:= true;
   218                 pixel:= Land[y, x] and Gear^.CollisionMask;
   222     inc(y)
   219     inc(y)
   223     until (y > i);
   220     until (y > i);
   224     end;
   221     end;
   225 TestCollisionXKick:= flag;
   222 TestCollisionXKick:= pixel;
   226 
   223 
   227 if flag then
   224 if pixel <> 0 then
   228     begin
   225     begin
   229     if hwAbs(Gear^.dX) < cHHKick then
   226     if hwAbs(Gear^.dX) < cHHKick then
   230         exit;
   227         exit;
   231     if (Gear^.State and gstHHJumping <> 0)
   228     if (Gear^.State and gstHHJumping <> 0)
   232     and (hwAbs(Gear^.dX) < _0_4) then
   229     and (hwAbs(Gear^.dX) < _0_4) then
   253                         State:= State or gstMoving;
   250                         State:= State or gstMoving;
   254                         if Kind = gtKnife then State:= State and (not gstCollision);
   251                         if Kind = gtKnife then State:= State and (not gstCollision);
   255                         Active:= true
   252                         Active:= true
   256                         end;
   253                         end;
   257                     DeleteCI(cGear);
   254                     DeleteCI(cGear);
   258                     TestCollisionXKick:= false;
   255                     exit(0);
   259                     exit;
       
   260                     end
   256                     end
   261     end
   257     end
   262 end;
   258 end;
   263 
   259 
   264 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
   260 function TestCollisionYKick(Gear: PGear; Dir: LongInt): Word;
   265 var x, y, mx, my,  myr, i: LongInt;
   261 var x, y, mx, my,  myr, i: LongInt;
   266     flag: boolean;
   262     pixel: Word;
   267 begin
   263 begin
   268 flag:= false;
   264 pixel:= 0;
   269 y:= hwRound(Gear^.Y);
   265 y:= hwRound(Gear^.Y);
   270 if Dir < 0 then
   266 if Dir < 0 then
   271     y:= y - Gear^.Radius
   267     y:= y - Gear^.Radius
   272 else
   268 else
   273     y:= y + Gear^.Radius;
   269     y:= y + Gear^.Radius;
   274 
   270 
   275 TestCollisionYKick:= true;
       
   276 if (y and LAND_HEIGHT_MASK) = 0 then
   271 if (y and LAND_HEIGHT_MASK) = 0 then
   277     begin
   272     begin
   278     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
   273     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
   279     i:= x + Gear^.Radius * 2 - 2;
   274     i:= x + Gear^.Radius * 2 - 2;
   280     repeat
   275     repeat
   281     if (x and LAND_WIDTH_MASK) = 0 then
   276     if (x and LAND_WIDTH_MASK) = 0 then
   282         if Land[y, x] > 0 then
   277         if Land[y, x] > 0 then
   283             if Land[y, x] > 255 then
   278             if Land[y, x] and Gear^.CollisionMask > 255 then
   284                 exit
   279                 exit(Land[y, x] and Gear^.CollisionMask)
   285             else if Land[y, x] <> 0 then
   280             else if Land[y, x] <> 0 then
   286                 flag:= true;
   281                 pixel:= Land[y, x] and Gear^.CollisionMask;
   287     inc(x)
   282     inc(x)
   288     until (x > i);
   283     until (x > i);
   289     end;
   284     end;
   290 TestCollisionYKick:= flag;
   285 TestCollisionYKick:= pixel;
   291 
   286 
   292 if flag then
   287 if pixel <> 0 then
   293     begin
   288     begin
   294     if hwAbs(Gear^.dY) < cHHKick then
   289     if hwAbs(Gear^.dY) < cHHKick then
   295         exit;
   290         exit;
   296     if (Gear^.State and gstHHJumping <> 0) and (not Gear^.dY.isNegative) and (Gear^.dY < _0_4) then
   291     if (Gear^.State and gstHHJumping <> 0) and (not Gear^.dY.isNegative) and (Gear^.dY < _0_4) then
   297         exit;
   292         exit;
   316                         State:= State or gstMoving;
   311                         State:= State or gstMoving;
   317                         if Kind = gtKnife then State:= State and (not gstCollision);
   312                         if Kind = gtKnife then State:= State and (not gstCollision);
   318                         Active:= true
   313                         Active:= true
   319                         end;
   314                         end;
   320                     DeleteCI(cGear);
   315                     DeleteCI(cGear);
   321                     TestCollisionYKick:= false;
   316                     exit(0)
   322                     exit
       
   323                     end
   317                     end
   324     end
   318     end
   325 end;
   319 end;
   326 
   320 
   327 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean; inline;
   321 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): Word; inline;
   328 begin
   322 begin
   329     TestCollisionXwithXYShift:= TestCollisionXwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
   323     TestCollisionXwithXYShift:= TestCollisionXwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
   330 end;
   324 end;
   331 
   325 
   332 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): boolean;
   326 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
   333 begin
   327 begin
   334 Gear^.X:= Gear^.X + ShiftX;
   328 Gear^.X:= Gear^.X + ShiftX;
   335 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
   329 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
   336 if withGear then 
   330 if withGear then 
   337     TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir)
   331     TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir)
   338 else TestCollisionXwithXYShift:= TestCollisionX(Gear, Dir);
   332 else TestCollisionXwithXYShift:= TestCollisionX(Gear, Dir);
   339 Gear^.X:= Gear^.X - ShiftX;
   333 Gear^.X:= Gear^.X - ShiftX;
   340 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
   334 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
   341 end;
   335 end;
   342 
   336 
   343 function TestCollisionX(Gear: PGear; Dir: LongInt): boolean;
   337 function TestCollisionX(Gear: PGear; Dir: LongInt): Word;
   344 var x, y, i: LongInt;
   338 var x, y, i: LongInt;
   345 begin
   339 begin
   346 x:= hwRound(Gear^.X);
   340 x:= hwRound(Gear^.X);
   347 if Dir < 0 then
   341 if Dir < 0 then
   348     x:= x - Gear^.Radius
   342     x:= x - Gear^.Radius
   349 else
   343 else
   350     x:= x + Gear^.Radius;
   344     x:= x + Gear^.Radius;
   351 
   345 
   352 TestCollisionX:= true;
       
   353 if (x and LAND_WIDTH_MASK) = 0 then
   346 if (x and LAND_WIDTH_MASK) = 0 then
   354     begin
   347     begin
   355     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   348     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   356     i:= y + Gear^.Radius * 2 - 2;
   349     i:= y + Gear^.Radius * 2 - 2;
   357     repeat
   350     repeat
   358         if (y and LAND_HEIGHT_MASK) = 0 then
   351         if (y and LAND_HEIGHT_MASK) = 0 then
   359             if Land[y, x] > 255 then
   352             if Land[y, x] and Gear^.CollisionMask > 255 then
   360                 exit;
   353                 exit(Land[y, x] and Gear^.CollisionMask);
   361     inc(y)
   354     inc(y)
   362     until (y > i);
   355     until (y > i);
   363     end;
   356     end;
   364 TestCollisionX:= false
   357 TestCollisionX:= 0
   365 end;
   358 end;
   366 
   359 
   367 function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
   360 function TestCollisionY(Gear: PGear; Dir: LongInt): Word;
   368 var x, y, i: LongInt;
   361 var x, y, i: LongInt;
   369 begin
   362 begin
   370 y:= hwRound(Gear^.Y);
   363 y:= hwRound(Gear^.Y);
   371 if Dir < 0 then
   364 if Dir < 0 then
   372     y:= y - Gear^.Radius
   365     y:= y - Gear^.Radius
   373 else
   366 else
   374     y:= y + Gear^.Radius;
   367     y:= y + Gear^.Radius;
   375 
   368 
   376 TestCollisionY:= true;
       
   377 if (y and LAND_HEIGHT_MASK) = 0 then
   369 if (y and LAND_HEIGHT_MASK) = 0 then
   378     begin
   370     begin
   379     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
   371     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
   380     i:= x + Gear^.Radius * 2 - 2;
   372     i:= x + Gear^.Radius * 2 - 2;
   381     repeat
   373     repeat
   382         if (x and LAND_WIDTH_MASK) = 0 then
   374         if (x and LAND_WIDTH_MASK) = 0 then
   383             if Land[y, x] > 255 then
   375             if Land[y, x] and Gear^.CollisionMask > 255 then
   384                 exit;
   376                 exit(Land[y, x] and Gear^.CollisionMask);
   385     inc(x)
   377     inc(x)
   386     until (x > i);
   378     until (x > i);
   387     end;
   379     end;
   388 TestCollisionY:= false
   380 TestCollisionY:= 0
   389 end;
   381 end;
   390 
   382 
   391 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean; inline;
   383 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): Word; inline;
   392 begin
   384 begin
   393     TestCollisionYwithXYShift:= TestCollisionYwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
   385     TestCollisionYwithXYShift:= TestCollisionYwithXYShift(Gear, ShiftX, ShiftY, Dir, true);
   394 end;
   386 end;
   395 
   387 
   396 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): boolean;
   388 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt; withGear: boolean): Word;
   397 begin
   389 begin
   398 Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
   390 Gear^.X:= Gear^.X + int2hwFloat(ShiftX);
   399 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
   391 Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY);
   400 
   392 
   401 if withGear then
   393 if withGear then
   402   TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir) <> 0
   394   TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir)
   403 else
   395 else
   404   TestCollisionYwithXYShift:= TestCollisionY(Gear, Dir);
   396   TestCollisionYwithXYShift:= TestCollisionY(Gear, Dir);
   405   
   397   
   406 Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
   398 Gear^.X:= Gear^.X - int2hwFloat(ShiftX);
   407 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)
   399 Gear^.Y:= Gear^.Y - int2hwFloat(ShiftY)