hedgewars/uCollisions.pas
changeset 3603 b6b1989744ef
parent 3569 27b0ec683572
child 3608 c509bbc779e7
equal deleted inserted replaced
3602:99c93fa258d6 3603:b6b1989744ef
    63 var Count: Longword;
    63 var Count: Longword;
    64     cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
    64     cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
    65     ga: TGearArray;
    65     ga: TGearArray;
    66 
    66 
    67 procedure AddGearCI(Gear: PGear);
    67 procedure AddGearCI(Gear: PGear);
       
    68 var i, j, k, tr: LongInt;
       
    69     tmpVals: array[0..8] of byte;
    68 begin
    70 begin
    69 if Gear^.CollisionIndex >= 0 then exit;
    71 if Gear^.CollisionIndex >= 0 then exit;
    70 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
    72 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
    71 with cinfos[Count] do
    73 with cinfos[Count] do
    72     begin
    74     begin
    73     X:= hwRound(Gear^.X);
    75     X:= hwRound(Gear^.X);
    74     Y:= hwRound(Gear^.Y);
    76     Y:= hwRound(Gear^.Y);
    75     Radius:= Gear^.Radius;
    77     Radius:= Gear^.Radius;
    76     ChangeRoundInLand(X, Y, Radius - 1, true);
    78     tr:= Radius - 1;
    77     cGear:= Gear
    79     ChangeRoundInLand(X, Y, tr, true);
       
    80     cGear:= Gear;
       
    81     k:= 0;
       
    82     for i:= -1 to 1 do
       
    83         for j:= -1 to 1 do
       
    84             begin
       
    85             tmpVals[k]:= LandCollided[(Y + tr*i) div 32, (X + tr*i) div 32];
       
    86             inc(k);
       
    87             end;
       
    88     k:= 0;
       
    89     for i:= -1 to 1 do
       
    90         for j:= -1 to 1 do
       
    91             begin
       
    92             if LandCollided[(Y + tr*i) div 32, (X + tr*i) div 32] < 255 then LandCollided[(Y + tr*i) div 32, (X + tr*i) div 32]:= tmpVals[k] + 1;
       
    93             inc(k)
       
    94             end
    78     end;
    95     end;
    79 Gear^.CollisionIndex:= Count;
    96 Gear^.CollisionIndex:= Count;
    80 inc(Count)
    97 inc(Count)
    81 end;
    98 end;
    82 
    99 
    83 procedure DeleteCI(Gear: PGear);
   100 procedure DeleteCI(Gear: PGear);
       
   101 var i, j, k, tr: LongInt;
       
   102     tmpVals: array[0..8] of byte;
    84 begin
   103 begin
    85 if Gear^.CollisionIndex >= 0 then
   104 if Gear^.CollisionIndex >= 0 then
    86     begin
   105     begin
    87     with cinfos[Gear^.CollisionIndex] do
   106     with cinfos[Gear^.CollisionIndex] do
    88         ChangeRoundInLand(X, Y, Radius - 1, false);
   107         begin
       
   108         tr:= Radius - 1;
       
   109         ChangeRoundInLand(X, Y, tr, false);
       
   110         k:= 0;
       
   111         for i:= -1 to 1 do
       
   112             for j:= -1 to 1 do
       
   113                 begin
       
   114                 tmpVals[k]:= LandCollided[(Y + tr*i) div 32, (X + tr*i) div 32];
       
   115                 inc(k);
       
   116                 end;
       
   117         k:= 0;
       
   118         for i:= -1 to 1 do
       
   119             for j:= -1 to 1 do
       
   120                 begin
       
   121                 if LandCollided[(Y + tr*i) div 32, (X + tr*i) div 32] > 0 then LandCollided[(Y + tr*i) div 32, (X + tr*i) div 32]:= tmpVals[k] - 1;
       
   122                 inc(k)
       
   123                 end
       
   124         end;
    89     cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
   125     cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
    90     cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
   126     cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
    91     Gear^.CollisionIndex:= -1;
   127     Gear^.CollisionIndex:= -1;
    92     dec(Count)
   128     dec(Count)
    93     end;
   129     end;
    94 end;
   130 end;
    95 
   131 
    96 function CheckGearsCollision(Gear: PGear): PGearArray;
   132 function CheckGearsCollision(Gear: PGear): PGearArray;
    97 var mx, my: LongInt;
   133 var mx, my, xP, xN, x0, yP, yN, y0, tr: LongInt;
    98     i: Longword;
   134     i: Longword;
    99 begin
   135 begin
   100 CheckGearsCollision:= @ga;
   136 CheckGearsCollision:= @ga;
   101 ga.Count:= 0;
   137 ga.Count:= 0;
   102 if Count = 0 then exit;
   138 if Count = 0 then exit;
   103 mx:= hwRound(Gear^.X);
   139 mx:= hwRound(Gear^.X);
   104 my:= hwRound(Gear^.Y);
   140 my:= hwRound(Gear^.Y);
   105 
   141 tr:= Gear^.Radius - 1;
   106 for i:= 0 to Pred(Count) do
   142 xP:= (mx + tr) div 32;
   107     with cinfos[i] do
   143 xN:= (mx - tr) div 32;
   108         if (Gear <> cGear) and
   144 yP:= (my + tr) div 32;
   109             (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) then
   145 yN:= (my - tr) div 32;
   110                 begin
   146 x0:= mx div 32;
   111                 ga.ar[ga.Count]:= cinfos[i].cGear;
   147 y0:= my div 32;
   112                 inc(ga.Count)
   148 
   113                 end
   149 if (LandCollided[yN, xN] <> 0) or
       
   150    (LandCollided[yN, x0] <> 0) or
       
   151    (LandCollided[yN, xP] <> 0) or
       
   152    (LandCollided[y0, xN] <> 0) or
       
   153    (LandCollided[y0, x0] <> 0) or
       
   154    (LandCollided[y0, xP] <> 0) or
       
   155    (LandCollided[yP, xN] <> 0) or
       
   156    (LandCollided[yP, x0] <> 0) or
       
   157    (LandCollided[yP, xP] <> 0) then 
       
   158     for i:= 0 to Pred(Count) do
       
   159         with cinfos[i] do
       
   160             if (Gear <> cGear) and
       
   161                 (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) then
       
   162                     begin
       
   163                     ga.ar[ga.Count]:= cinfos[i].cGear;
       
   164                     inc(ga.Count)
       
   165                     end
   114 end;
   166 end;
   115 
   167 
   116 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   168 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   117 var x, y, i: LongInt;
   169 var x, y, i: LongInt;
   118     TestWord: LongWord;
   170     TestWord: LongWord;
   174    end;
   226    end;
   175 TestCollisionYwithGear:= false
   227 TestCollisionYwithGear:= false
   176 end;
   228 end;
   177 
   229 
   178 function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
   230 function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
   179 var x, y, mx, my, i: LongInt;
   231 var x, y, mx, my, i, xP, xN, x0, yP, yN, y0, tr: LongInt;
   180     flag: boolean;
   232     flag: boolean;
   181 begin
   233 begin
   182 flag:= false;
   234 flag:= false;
   183 x:= hwRound(Gear^.X);
   235 x:= hwRound(Gear^.X);
   184 if Dir < 0 then x:= x - Gear^.Radius
   236 if Dir < 0 then x:= x - Gear^.Radius
   202    if (Gear^.State and gstHHJumping <> 0)
   254    if (Gear^.State and gstHHJumping <> 0)
   203    and (hwAbs(Gear^.dX) < _0_4) then exit;
   255    and (hwAbs(Gear^.dX) < _0_4) then exit;
   204 
   256 
   205    mx:= hwRound(Gear^.X);
   257    mx:= hwRound(Gear^.X);
   206    my:= hwRound(Gear^.Y);
   258    my:= hwRound(Gear^.Y);
   207 
   259    tr:= Gear^.Radius - 1;
   208    for i:= 0 to Pred(Count) do
   260    xP:= (mx + tr) div 32;
   209     with cinfos[i] do
   261    xN:= (mx - tr) div 32;
   210       if (Gear <> cGear) and
   262    yP:= (my + tr) div 32;
   211          (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
   263    yN:= (my - tr) div 32;
   212          ((mx > x) xor (Dir > 0)) then
   264    x0:= mx div 32;
   213          if ((cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0)) or
   265    y0:= my div 32;
   214             // only apply X kick if the barrel is knocked over
   266 
   215             ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0)) then
   267    if (LandCollided[yN, xN] <> 0) or
   216              begin
   268       (LandCollided[yN, x0] <> 0) or
   217              with cGear^ do
   269       (LandCollided[yN, xP] <> 0) or
   218                   begin
   270       (LandCollided[y0, xN] <> 0) or
   219                   dX:= Gear^.dX;
   271       (LandCollided[y0, x0] <> 0) or
   220                   dY:= Gear^.dY * _0_5;
   272       (LandCollided[y0, xP] <> 0) or
   221                   State:= State or gstMoving;
   273       (LandCollided[yP, xN] <> 0) or
   222                   Active:= true
   274       (LandCollided[yP, x0] <> 0) or
   223                   end;
   275       (LandCollided[yP, xP] <> 0) then 
   224              DeleteCI(cGear);
   276       for i:= 0 to Pred(Count) do
   225              exit(false)
   277        with cinfos[i] do
   226              end
   278          if (Gear <> cGear) and
   227    end
   279             (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
       
   280             ((mx > x) xor (Dir > 0)) then
       
   281             if ((cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0)) or
       
   282                // only apply X kick if the barrel is knocked over
       
   283                ((cGear^.Kind = gtExplosives) and ((cGear^.State and gsttmpflag) <> 0)) then
       
   284                 begin
       
   285                 with cGear^ do
       
   286                      begin
       
   287                      dX:= Gear^.dX;
       
   288                      dY:= Gear^.dY * _0_5;
       
   289                      State:= State or gstMoving;
       
   290                      Active:= true
       
   291                      end;
       
   292                 DeleteCI(cGear);
       
   293                 exit(false)
       
   294                 end
       
   295       end
   228 end;
   296 end;
   229 
   297 
   230 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
   298 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
   231 var x, y, mx, my, i: LongInt;
   299 var x, y, mx, my, i, xP, xN, x0, yP, yN, y0, tr: LongInt;
   232     flag: boolean;
   300     flag: boolean;
   233 begin
   301 begin
   234 flag:= false;
   302 flag:= false;
   235 y:= hwRound(Gear^.Y);
   303 y:= hwRound(Gear^.Y);
   236 if Dir < 0 then y:= y - Gear^.Radius
   304 if Dir < 0 then y:= y - Gear^.Radius
   256    and (not Gear^.dY.isNegative)
   324    and (not Gear^.dY.isNegative)
   257    and (Gear^.dY < _0_4) then exit;
   325    and (Gear^.dY < _0_4) then exit;
   258 
   326 
   259    mx:= hwRound(Gear^.X);
   327    mx:= hwRound(Gear^.X);
   260    my:= hwRound(Gear^.Y);
   328    my:= hwRound(Gear^.Y);
   261 
   329    tr:= Gear^.Radius - 1;
   262    for i:= 0 to Pred(Count) do
   330    xP:= (mx + tr) div 32;
   263     with cinfos[i] do
   331    xN:= (mx - tr) div 32;
   264       if (Gear <> cGear) and
   332    yP:= (my + tr) div 32;
   265          (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
   333    yN:= (my - tr) div 32;
   266          ((my > y) xor (Dir > 0)) then
   334    x0:= mx div 32;
   267          if (cGear^.Kind in [gtHedgehog, gtMine, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
   335    y0:= my div 32;
   268              begin
   336 
   269              with cGear^ do
   337    if (LandCollided[yN, xN] <> 0) or
   270                   begin
   338       (LandCollided[yN, x0] <> 0) or
   271                   if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then dX:= Gear^.dX * _0_5;
   339       (LandCollided[yN, xP] <> 0) or
   272                   dY:= Gear^.dY;
   340       (LandCollided[y0, xN] <> 0) or
   273                   State:= State or gstMoving;
   341       (LandCollided[y0, x0] <> 0) or
   274                   Active:= true
   342       (LandCollided[y0, xP] <> 0) or
   275                   end;
   343       (LandCollided[yP, xN] <> 0) or
   276              DeleteCI(cGear);
   344       (LandCollided[yP, x0] <> 0) or
   277              exit(false)
   345       (LandCollided[yP, xP] <> 0) then 
   278              end
   346       for i:= 0 to Pred(Count) do
   279    end
   347        with cinfos[i] do
       
   348          if (Gear <> cGear) and
       
   349             (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius + 2)) and
       
   350             ((my > y) xor (Dir > 0)) then
       
   351             if (cGear^.Kind in [gtHedgehog, gtMine, gtExplosives]) and ((Gear^.State and gstNotKickable) = 0) then
       
   352                 begin
       
   353                 with cGear^ do
       
   354                      begin
       
   355                      if (Kind <> gtExplosives) or ((State and gsttmpflag) <> 0) then dX:= Gear^.dX * _0_5;
       
   356                      dY:= Gear^.dY;
       
   357                      State:= State or gstMoving;
       
   358                      Active:= true
       
   359                      end;
       
   360                 DeleteCI(cGear);
       
   361                 exit(false)
       
   362                 end
       
   363       end
   280 end;
   364 end;
   281 
   365 
   282 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
   366 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
   283 begin
   367 begin
   284 Gear^.X:= Gear^.X + ShiftX;
   368 Gear^.X:= Gear^.X + ShiftX;