hedgewars/uCollisions.pas
changeset 68 cbb93eb90304
parent 64 9df467527ae5
child 70 82d93eeecebe
equal deleted inserted replaced
67:3101306251e5 68:cbb93eb90304
    47                   end;
    47                   end;
    48 
    48 
    49 procedure AddGearCI(Gear: PGear);
    49 procedure AddGearCI(Gear: PGear);
    50 procedure DeleteCI(Gear: PGear);
    50 procedure DeleteCI(Gear: PGear);
    51 function CheckGearsCollision(Gear: PGear): PGearArray;
    51 function CheckGearsCollision(Gear: PGear): PGearArray;
    52 function  HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
       
    53 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
    52 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
    54 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
    53 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
       
    54 function TestCollisionY(Gear: PGear; Dir: integer): boolean;
    55 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
    55 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
    56 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
    56 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
    57 
    57 
    58 implementation
    58 implementation
    59 uses uMisc, uConsts, uLand, uLandGraphics;
    59 uses uMisc, uConsts, uLand, uLandGraphics;
   114              ga.ar[ga.Count]:= cinfos[i].cGear;
   114              ga.ar[ga.Count]:= cinfos[i].cGear;
   115              inc(ga.Count)
   115              inc(ga.Count)
   116              end;
   116              end;
   117 end;
   117 end;
   118 
   118 
   119 function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
       
   120 var x, y, i: integer;
       
   121 begin
       
   122 Result:= false;
       
   123 y:= round(Gear.Y);
       
   124 if Dir < 0 then y:= y - Gear.Radius
       
   125            else y:= y + Gear.Radius;
       
   126            
       
   127 if ((y - Dir) and $FFFFFC00) = 0 then
       
   128    begin
       
   129    x:= round(Gear.X);
       
   130    if (((x - Gear.Radius) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.Radius] <> 0)
       
   131     or(((x + Gear.Radius) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.Radius] <> 0) then
       
   132       begin
       
   133       Result:= true;
       
   134       exit
       
   135       end
       
   136     end;
       
   137 
       
   138 if (y and $FFFFFC00) = 0 then
       
   139    begin
       
   140    x:= round(Gear.X) - Gear.Radius + 1;
       
   141    i:= x + Gear.Radius * 2 - 2;
       
   142    repeat
       
   143      if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
       
   144      inc(x)
       
   145    until (x > i) or Result
       
   146    end
       
   147 end;
       
   148 
       
   149 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
   119 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
   150 var x, y, i: integer;
   120 var x, y, i: integer;
   151 begin
   121 begin
   152 Result:= false;
   122 Result:= false;
   153 x:= round(Gear.X);
   123 x:= round(Gear.X);
   154 if Dir < 0 then x:= x - Gear.Radius - 1
   124 if Dir < 0 then x:= x - Gear.Radius
   155            else x:= x + Gear.Radius + 1;
   125            else x:= x + Gear.Radius;
   156 if (x and $FFFFF800) = 0 then
   126 if (x and $FFFFF800) = 0 then
   157    begin
   127    begin
   158    y:= round(Gear.Y) - Gear.Radius + 1;
   128    y:= round(Gear.Y) - Gear.Radius + 1;
   159    i:= y + Gear.Radius * 2 - 2;
   129    i:= y + Gear.Radius * 2 - 2;
   160    repeat
   130    repeat
   181 if Dir < 0 then y:= y - Gear.Radius
   151 if Dir < 0 then y:= y - Gear.Radius
   182            else y:= y + Gear.Radius;
   152            else y:= y + Gear.Radius;
   183 if (y and $FFFFFC00) = 0 then
   153 if (y and $FFFFFC00) = 0 then
   184    begin
   154    begin
   185    x:= round(Gear.X) - Gear.Radius + 1;
   155    x:= round(Gear.X) - Gear.Radius + 1;
   186    i:= x + Gear.Radius * 2 - 2;            
   156    i:= x + Gear.Radius * 2 - 2;
   187    repeat
   157    repeat
   188      if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
   158      if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
       
   159      inc(x)
       
   160    until (x > i) or Result;
       
   161    end
       
   162 end;
       
   163 
       
   164 function TestCollisionY(Gear: PGear; Dir: integer): boolean;
       
   165 var x, y, i: integer;
       
   166 begin
       
   167 Result:= false;
       
   168 y:= round(Gear.Y);
       
   169 if Dir < 0 then y:= y - Gear.Radius
       
   170            else y:= y + Gear.Radius;
       
   171 if (y and $FFFFFC00) = 0 then
       
   172    begin
       
   173    x:= round(Gear.X) - Gear.Radius + 1;
       
   174    i:= x + Gear.Radius * 2 - 2;
       
   175    repeat
       
   176      if (x and $FFFFF800) = 0 then Result:= Land[y, x] = COLOR_LAND;
   189      inc(x)
   177      inc(x)
   190    until (x > i) or Result;
   178    until (x > i) or Result;
   191    end
   179    end
   192 end;
   180 end;
   193 
   181