hedgewars/uCollisions.pas
changeset 513 69e06d710d46
parent 511 2b5b9e00419d
child 514 fb8ba88a83c3
equal deleted inserted replaced
512:efc640bb60d0 513:69e06d710d46
    28                   Count: Longword
    28                   Count: Longword
    29                   end;
    29                   end;
    30 
    30 
    31 procedure AddGearCI(Gear: PGear);
    31 procedure AddGearCI(Gear: PGear);
    32 procedure DeleteCI(Gear: PGear);
    32 procedure DeleteCI(Gear: PGear);
       
    33 
    33 function CheckGearsCollision(Gear: PGear): PGearArray;
    34 function CheckGearsCollision(Gear: PGear): PGearArray;
       
    35 
    34 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
    36 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
    35 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
    37 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean;
       
    38 
       
    39 function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
       
    40 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
       
    41 
    36 function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
    42 function TestCollisionY(Gear: PGear; Dir: LongInt): boolean;
       
    43 
    37 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
    44 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
    38 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
    45 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean;
    39 
    46 
    40 implementation
    47 implementation
    41 uses uMisc, uConsts, uLand, uLandGraphics, uConsole;
    48 uses uMisc, uConsts, uLand, uLandGraphics, uConsole;
   141         if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y) - Radius) or
   148         if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y) - Radius) or
   142            (hwRound(IntersectGear^.Y) - IntersectGear^.Radius > hwRound(Y) + Radius) then
   149            (hwRound(IntersectGear^.Y) - IntersectGear^.Radius > hwRound(Y) + Radius) then
   143            begin
   150            begin
   144            IntersectGear:= nil;
   151            IntersectGear:= nil;
   145            TestWord:= 0
   152            TestWord:= 0
   146            end else    
   153            end else
   147            TestWord:= COLOR_LAND - 1
   154            TestWord:= COLOR_LAND - 1
   148    else TestWord:= 0;
   155    else TestWord:= 0;
   149 
   156 
   150 y:= hwRound(Gear^.Y);
   157 y:= hwRound(Gear^.Y);
   151 if Dir < 0 then y:= y - Gear^.Radius
   158 if Dir < 0 then y:= y - Gear^.Radius
   159         if Land[y, x] > TestWord then exit(true);
   166         if Land[y, x] > TestWord then exit(true);
   160      inc(x)
   167      inc(x)
   161    until (x > i);
   168    until (x > i);
   162    end;
   169    end;
   163 TestCollisionYwithGear:= false
   170 TestCollisionYwithGear:= false
       
   171 end;
       
   172 
       
   173 function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean;
       
   174 var x, y, mx, my, i: LongInt;
       
   175     flag: boolean;
       
   176 begin
       
   177 flag:= false;
       
   178 x:= hwRound(Gear^.X);
       
   179 if Dir < 0 then x:= x - Gear^.Radius
       
   180            else x:= x + Gear^.Radius;
       
   181 if (x and $FFFFF800) = 0 then
       
   182    begin
       
   183    y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
       
   184    i:= y + Gear^.Radius * 2 - 2;
       
   185    repeat
       
   186      if (y and $FFFFFC00) = 0 then
       
   187            if Land[y, x] = COLOR_LAND then exit(true)
       
   188                                       else flag:= true;
       
   189      inc(y)
       
   190    until (y > i);
       
   191    end;
       
   192 TestCollisionXKick:= false;
       
   193 
       
   194 if flag then
       
   195    begin
       
   196    if Count = 0 then exit;
       
   197    mx:= hwRound(Gear^.X);
       
   198    my:= hwRound(Gear^.Y);
       
   199 
       
   200    for i:= 0 to Pred(Count) do
       
   201     with cinfos[i] do
       
   202       if (Gear <> cGear) and
       
   203          (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) and
       
   204          ((mx > x) xor (Dir > 0)) then
       
   205              begin
       
   206              Gear^.dX:= Gear^.dX {* _0_6};
       
   207              Gear^.dY:= Gear^.dY {* _0_6};
       
   208              with cinfos[i].cGear^ do
       
   209                   begin
       
   210                   dX:= Gear^.dX {* _1_5};
       
   211                   dY:= Gear^.dY {* _1_5};
       
   212                   State:= State and gstMoving;
       
   213                   Active:= true
       
   214                   end;
       
   215              DeleteCI(cinfos[i].cGear);
       
   216              exit
       
   217              end
       
   218    end
       
   219 end;
       
   220 
       
   221 function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean;
       
   222 var x, y, mx, my, i: LongInt;
       
   223     flag: boolean;
       
   224 begin
       
   225 flag:= false;
       
   226 y:= hwRound(Gear^.Y);
       
   227 if Dir < 0 then y:= y - Gear^.Radius
       
   228            else y:= y + Gear^.Radius;
       
   229 if (y and $FFFFFC00) = 0 then
       
   230    begin
       
   231    x:= hwRound(Gear^.X) - Gear^.Radius + 1;
       
   232    i:= x + Gear^.Radius * 2 - 2;
       
   233    repeat
       
   234      if (x and $FFFFF800) = 0 then
       
   235         if Land[y, x] > 0 then
       
   236            if Land[y, x] = COLOR_LAND then exit(true)
       
   237                                       else flag:= true;
       
   238      inc(x)
       
   239    until (x > i);
       
   240    end;
       
   241 TestCollisionYKick:= false;
       
   242 
       
   243 if flag then
       
   244    begin
       
   245    if Count = 0 then exit;
       
   246    mx:= hwRound(Gear^.X);
       
   247    my:= hwRound(Gear^.Y);
       
   248 
       
   249    for i:= 0 to Pred(Count) do
       
   250     with cinfos[i] do
       
   251       if (Gear <> cGear) and
       
   252          (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) and
       
   253          ((my > y) xor (Dir > 0)) then
       
   254              begin
       
   255              Gear^.dX:= Gear^.dX * _0_6;
       
   256              Gear^.dY:= Gear^.dY * _0_6;
       
   257              with cinfos[i].cGear^ do
       
   258                   begin
       
   259                   dX:= Gear^.dX {* _1_5};
       
   260                   dY:= Gear^.dY {* _1_5};
       
   261                   State:= State and gstMoving;
       
   262                   Active:= true
       
   263                   end;
       
   264              DeleteCI(cinfos[i].cGear);
       
   265              exit
       
   266              end
       
   267    end
   164 end;
   268 end;
   165 
   269 
   166 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
   270 function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean;
   167 begin
   271 begin
   168 Gear^.X:= Gear^.X + ShiftX;
   272 Gear^.X:= Gear^.X + ShiftX;