hedgewars/uCollisions.pas
changeset 7272 71df899c4163
parent 7270 93e92e82d5c8
child 7305 b242e91a92a9
equal deleted inserted replaced
7270:93e92e82d5c8 7272:71df899c4163
   136 
   136 
   137 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   137 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   138 var x, y, i: LongInt;
   138 var x, y, i: LongInt;
   139     TestWord: LongWord;
   139     TestWord: LongWord;
   140 begin
   140 begin
   141 if Gear^.IntersectGear <> nil then
   141 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   142     with Gear^ do
   142 if (Gear^.CollisionMask = $FF7F) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   143         if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X) - Radius)
   143     ((hwRound(Gear^.Hedgehog^.Gear^.X) + Gear^.Hedgehog^.Gear^.Radius + 4 < hwRound(Gear^.X) - Gear^.Radius) or
   144         or (hwRound(IntersectGear^.X) - IntersectGear^.Radius > hwRound(X) + Radius) then
   144      (hwRound(Gear^.Hedgehog^.Gear^.X) - Gear^.Hedgehog^.Gear^.Radius - 4 > hwRound(Gear^.X) + Gear^.Radius)) then
   145             begin
   145     Gear^.CollisionMask:= $FFFF;
   146             IntersectGear:= nil;
       
   147             TestWord:= 0
       
   148             end
       
   149         else
       
   150             TestWord:= 255
       
   151 else 
       
   152     TestWord:= 0;
       
   153 
   146 
   154 x:= hwRound(Gear^.X);
   147 x:= hwRound(Gear^.X);
   155 if Dir < 0 then
   148 if Dir < 0 then
   156     x:= x - Gear^.Radius
   149     x:= x - Gear^.Radius
   157 else
   150 else
   162     begin
   155     begin
   163     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   156     y:= hwRound(Gear^.Y) - Gear^.Radius + 1;
   164     i:= y + Gear^.Radius * 2 - 2;
   157     i:= y + Gear^.Radius * 2 - 2;
   165     repeat
   158     repeat
   166         if (y and LAND_HEIGHT_MASK) = 0 then
   159         if (y and LAND_HEIGHT_MASK) = 0 then
   167             if Land[y, x] > TestWord then
   160             if Land[y, x] and Gear^.CollisionMask <> 0 then
   168                 exit;
   161                 exit;
   169         inc(y)
   162         inc(y)
   170     until (y > i);
   163     until (y > i);
   171     end;
   164     end;
   172 TestCollisionXwithGear:= false
   165 TestCollisionXwithGear:= false
   174 
   167 
   175 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
   168 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
   176 var x, y, i: LongInt;
   169 var x, y, i: LongInt;
   177     TestWord: LongWord;
   170     TestWord: LongWord;
   178 begin
   171 begin
   179 if Gear^.IntersectGear <> nil then
   172 // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap
   180     with Gear^ do
   173 if (Gear^.CollisionMask = $FF7F) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and
   181         if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y) - Radius) or
   174     ((hwRound(Gear^.Hedgehog^.Gear^.Y) + Gear^.Hedgehog^.Gear^.Radius + 4 < hwRound(Gear^.Y) - Gear^.Radius) or
   182             (hwRound(IntersectGear^.Y) - IntersectGear^.Radius > hwRound(Y) + Radius) then
   175      (hwRound(Gear^.Hedgehog^.Gear^.Y) - Gear^.Hedgehog^.Gear^.Radius - 4 > hwRound(Gear^.Y) + Gear^.Radius)) then
   183                 begin
   176     Gear^.CollisionMask:= $FFFF;
   184                 IntersectGear:= nil;
       
   185                 TestWord:= 0
       
   186                 end
       
   187         else
       
   188             TestWord:= 255
       
   189 else
       
   190     TestWord:= 0;
       
   191 
   177 
   192 y:= hwRound(Gear^.Y);
   178 y:= hwRound(Gear^.Y);
   193 if Dir < 0 then
   179 if Dir < 0 then
   194     y:= y - Gear^.Radius
   180     y:= y - Gear^.Radius
   195 else
   181 else
   199     begin
   185     begin
   200     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
   186     x:= hwRound(Gear^.X) - Gear^.Radius + 1;
   201     i:= x + Gear^.Radius * 2 - 2;
   187     i:= x + Gear^.Radius * 2 - 2;
   202     repeat
   188     repeat
   203         if (x and LAND_WIDTH_MASK) = 0 then
   189         if (x and LAND_WIDTH_MASK) = 0 then
   204             if Land[y, x] > TestWord then
   190             if Land[y, x] and Gear^.CollisionMask <> 0 then
   205             begin
   191                 begin
   206                 TestCollisionYwithGear:= Land[y, x];
   192                 TestCollisionYwithGear:= Land[y, x];
   207                 exit;
   193                 exit;
   208             end;
   194                 end;
   209      inc(x)
   195         inc(x)
   210     until (x > i);
   196     until (x > i);
   211     end;
   197     end;
   212 TestCollisionYwithGear:= 0
   198 TestCollisionYwithGear:= 0
   213 end;
   199 end;
   214 
   200