1 (*

     2  * Hedgewars, a worms-like game

     3  * Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * Distributed under the terms of the BSD-modified licence:

     6  *

     7  * Permission is hereby granted, free of charge, to any person obtaining a copy

     8  * of this software and associated documentation files (the "Software"), to deal

     9  * with the Software without restriction, including without limitation the

    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

    11  * sell copies of the Software, and to permit persons to whom the Software is

    12  * furnished to do so, subject to the following conditions:

    13  *

    14  * 1. Redistributions of source code must retain the above copyright notice,

    15  *    this list of conditions and the following disclaimer.

    16  * 2. Redistributions in binary form must reproduce the above copyright notice,

    17  *    this list of conditions and the following disclaimer in the documentation

    18  *    and/or other materials provided with the distribution.

    19  * 3. The name of the author may not be used to endorse or promote products

    20  *    derived from this software without specific prior written permission.

    21  *

    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uCollisions;

    35 interface

    36 uses uGears;

    37 {$INCLUDE options.inc}

    38 

    39 type TCollisionEntry = record

    40                        X, Y, HWidth, HHeight: integer;

    41                        cGear: PGear;

    42                        end;

    43 

    44 procedure AddGearCR(Gear: PGear);

    45 procedure UpdateCR(NewX, NewY: integer; Index: Longword);

    46 procedure DeleteCR(Gear: PGear);

    47 function  CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean;

    48 function  HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;

    49 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;

    50 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;

    51 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;

    52 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;

    53 function TestCollisionY(Gear: PGear; Dir: integer): boolean;

    54 

    55 implementation

    56 uses uMisc, uConsts, uLand;

    57 

    58 const MAXRECTSINDEX = 255;

    59 var Count: Longword = 0;

    60     crects: array[0..MAXRECTSINDEX] of TCollisionEntry;

    61 

    62 procedure AddGearCR(Gear: PGear);

    63 begin

    64 {$IFDEF DEBUGFILE}AddFileLog('AddCR crects count = ' + inttostr(Count));{$ENDIF}

    65 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);

    66 with crects[Count] do

    67      begin

    68      X:= round(Gear.X);

    69      Y:= round(Gear.Y);

    70      HWidth:= Gear.HalfWidth;

    71      HHeight:= Gear.HalfHeight;

    72      cGear:= Gear

    73      end;

    74 Gear.CollIndex:= Count;

    75 inc(Count)

    76 end;

    77 

    78 procedure UpdateCR(NewX, NewY: integer; Index: Longword);

    79 begin

    80 with crects[Index] do

    81      begin

    82      X:= NewX;

    83      Y:= NewY

    84      end

    85 end;

    86 

    87 procedure DeleteCR(Gear: PGear);

    88 begin

    89 {$IFDEF DEBUGFILE}AddFileLog('DelCR crects count = ' + inttostr(Count) + ' deleting ' + inttostr(Gear.CollIndex));{$ENDIF}

    90 if Gear.CollIndex < Pred(Count) then

    91    begin

    92    crects[Gear.CollIndex]:= crects[Pred(Count)];

    93    crects[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex

    94    end;

    95 Gear.CollIndex:= High(Longword);

    96 dec(Count)

    97 end;

    98 

    99 function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean;

   100 var x1, x2, y1, y2: integer;

   101     i: Longword;

   102 begin

   103 x1:= round(Gear.X);

   104 y1:= round(Gear.Y);

   105 {if (Gear.State and gstOutOfHH) = 0 then

   106    begin

   107    p:= PHedgehog(Gear.Hedgehog)^.Gear;

   108    if (p <> nil) and

   109         ((x1 + Gear.HalfWidth < round(p.X) - p.HalfWidth)

   110       or (x1 - Gear.HalfWidth > round(p.X) + p.HalfWidth)

   111       or (y1 - Gear.HalfHeight > round(p.Y) + p.HalfHeight)

   112       or (y1 + Gear.HalfHeight < round(p.Y) - p.HalfHeight)) then Gear.State:= Gear.State or gstOutOfHH;

   113    end; }

   114 Result:= false;

   115 if forX then

   116    begin

   117    x1:= x1 + Dir*Gear.HalfWidth;

   118    x2:= x1;

   119    y2:= y1 + Gear.HalfHeight - 1;

   120    y1:= y1 - Gear.HalfHeight + 1

   121    end else

   122    begin

   123    y1:= y1 + Dir*Gear.HalfHeight;

   124    y2:= y1;

   125    x2:= x1 + Gear.HalfWidth - 1;

   126    x1:= x1 - Gear.HalfWidth + 1

   127    end;

   128 

   129 for i:= 0 to Pred(Count) do

   130    with crects[i] do

   131       if  (Gear.CollIndex <> i)

   132 //      if ((p.Kind = gtHedgehog) and ((p.Hedgehog <> Gear.Hedgehog) or ((Gear.State and gstOutOfHH) <> 0)))

   133          and (x1 <= X + HWidth)

   134          and (x2 >= X - HWidth)

   135          and (y1 <= Y + HHeight)

   136          and (y2 >= Y - HHeight) then

   137              begin

   138              Result:= true;

   139              exit

   140              end;

   141 end;

   142 

   143 function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;

   144 var x, y, i: integer;

   145 begin

   146 Result:= false;

   147 y:= round(Gear.Y);

   148 if Dir < 0 then y:= y - Gear.HalfHeight

   149            else y:= y + Gear.HalfHeight;

   150            

   151 if ((y - Dir) and $FFFFFC00) = 0 then

   152    begin

   153    x:= round(Gear.X);

   154    if (((x - Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.HalfWidth] <> 0)

   155     or(((x + Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.HalfWidth] <> 0) then

   156       begin

   157       Result:= true;

   158       exit

   159       end

   160     end;

   161 

   162 if (y and $FFFFFC00) = 0 then

   163    begin

   164    x:= round(Gear.X) - Gear.HalfWidth + 1;

   165    i:= x + Gear.HalfWidth * 2 - 2;

   166    repeat

   167      if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;

   168      inc(x)

   169    until (x > i) or Result;

   170    if Result then exit;

   171 

   172    Result:= CheckGearsCollision(Gear, Dir, false)

   173    end

   174 end;

   175 

   176 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;

   177 var x, y, i: integer;

   178 begin

   179 Result:= false;

   180 x:= round(Gear.X);

   181 if Dir < 0 then x:= x - Gear.HalfWidth

   182            else x:= x + Gear.HalfWidth;

   183 if (x and $FFFFF800) = 0 then

   184    begin

   185    y:= round(Gear.Y) - Gear.HalfHeight + 1; {*}

   186    i:= y + Gear.HalfHeight * 2 - 2;         {*}

   187    repeat

   188      if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0;

   189      inc(y)

   190    until (y > i) or Result;

   191    if Result then exit;

   192    Result:= CheckGearsCollision(Gear, Dir, true)

   193    end

   194 end;

   195 

   196 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;

   197 begin

   198 Gear.X:= Gear.X + ShiftX;

   199 Gear.Y:= Gear.Y + ShiftY;

   200 Result:= TestCollisionXwithGear(Gear, Dir);

   201 Gear.X:= Gear.X - ShiftX;

   202 Gear.Y:= Gear.Y - ShiftY

   203 end;

   204 

   205 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;

   206 var x, y, i: integer;

   207 begin

   208 Result:= false;

   209 y:= round(Gear.Y);

   210 if Dir < 0 then y:= y - Gear.HalfHeight

   211            else y:= y + Gear.HalfHeight;

   212 if (y and $FFFFFC00) = 0 then

   213    begin

   214    x:= round(Gear.X) - Gear.HalfWidth + 1;    {*}

   215    i:= x + Gear.HalfWidth * 2 - 2;            {*}

   216    repeat

   217      if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;

   218      inc(x)

   219    until (x > i) or Result;

   220    if Result then exit;

   221    Result:= CheckGearsCollision(Gear, Dir, false);

   222    end

   223 end;

   224 

   225 function TestCollisionY(Gear: PGear; Dir: integer): boolean;

   226 var x, y, i: integer;

   227 begin

   228 Result:= false;

   229 y:= round(Gear.Y);

   230 if Dir < 0 then y:= y - Gear.HalfHeight

   231            else y:= y + Gear.HalfHeight;

   232 if (y and $FFFFFC00) = 0 then

   233    begin

   234    x:= round(Gear.X) - Gear.HalfWidth + 1;    {*}

   235    i:= x + Gear.HalfWidth * 2 - 2;            {*}

   236    repeat

   237      if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;

   238      inc(x)

   239    until (x > i) or Result;

   240    end

   241 end;

   242 

   243 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;

   244 begin

   245 Gear.X:= Gear.X + ShiftX;

   246 Gear.Y:= Gear.Y + ShiftY;

   247 Result:= TestCollisionYwithGear(Gear, Dir);

   248 Gear.X:= Gear.X - ShiftX;

   249 Gear.Y:= Gear.Y - ShiftY

   250 end;

   251 

   252 end.