33 |
33 |
34 unit uCollisions; |
34 unit uCollisions; |
35 interface |
35 interface |
36 uses uGears; |
36 uses uGears; |
37 {$INCLUDE options.inc} |
37 {$INCLUDE options.inc} |
38 |
38 const cMaxGearArrayInd = 255; |
39 type TCollisionEntry = record |
39 |
40 X, Y, HWidth, HHeight: integer; |
40 type TDirection = record |
41 cGear: PGear; |
41 dX, dY: integer |
42 end; |
42 end; |
43 |
43 PGearArray = ^TGearArray; |
44 procedure AddGearCR(Gear: PGear); |
44 TGearArray = record |
45 procedure UpdateCR(NewX, NewY: integer; Index: Longword); |
45 ar: array[0..cMaxGearArrayInd] of PGear; |
46 procedure DeleteCR(Gear: PGear); |
46 Count: Longword |
47 function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): PGear; |
47 end; |
|
48 |
|
49 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword); |
|
50 procedure AddGearCI(Gear: PGear); |
|
51 procedure DeleteCI(Gear: PGear); |
|
52 function CheckGearsCollision(Gear: PGear): PGearArray; |
48 function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
53 function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
49 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
54 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
50 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
55 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
51 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
56 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
52 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
57 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
53 function TestCollisionY(Gear: PGear; Dir: integer): boolean; |
|
54 |
58 |
55 implementation |
59 implementation |
56 uses uMisc, uConsts, uLand; |
60 uses uMisc, uConsts, uLand; |
57 |
61 |
|
62 type TCollisionEntry = record |
|
63 X, Y, Radius: integer; |
|
64 cGear: PGear; |
|
65 end; |
|
66 |
58 const MAXRECTSINDEX = 255; |
67 const MAXRECTSINDEX = 255; |
59 var Count: Longword = 0; |
68 var Count: Longword = 0; |
60 crects: array[0..MAXRECTSINDEX] of TCollisionEntry; |
69 cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry; |
61 |
70 ga: TGearArray; |
62 procedure AddGearCR(Gear: PGear); |
71 |
63 begin |
72 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword); |
|
73 var ty, tx: integer; |
|
74 begin |
|
75 for ty:= max(-Radius, -y) to min(radius, 1023 - y) do |
|
76 for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047,round(x+radius*sqrt(1-sqr(ty/radius)))) do |
|
77 Land[ty + y, tx]:= Value; |
|
78 end; |
|
79 |
|
80 procedure AddGearCI(Gear: PGear); |
|
81 begin |
|
82 if Gear.CollIndex < High(Longword) then exit; |
64 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true); |
83 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true); |
65 with crects[Count] do |
84 with cinfos[Count] do |
66 begin |
85 begin |
67 X:= round(Gear.X); |
86 X:= round(Gear.X); |
68 Y:= round(Gear.Y); |
87 Y:= round(Gear.Y); |
69 HWidth:= Gear.HalfWidth; |
88 Radius:= Gear.Radius; |
70 HHeight:= Gear.HalfHeight; |
89 FillRoundInLand(X, Y, Radius, $FF); |
71 cGear:= Gear |
90 cGear:= Gear |
72 end; |
91 end; |
73 Gear.CollIndex:= Count; |
92 Gear.CollIndex:= Count; |
74 inc(Count) |
93 inc(Count) |
75 end; |
94 end; |
76 |
95 |
77 procedure UpdateCR(NewX, NewY: integer; Index: Longword); |
96 procedure DeleteCI(Gear: PGear); |
78 begin |
97 begin |
79 with crects[Index] do |
98 if Gear.CollIndex < Count then |
80 begin |
99 begin |
81 X:= NewX; |
100 with cinfos[Gear.CollIndex] do FillRoundInLand(X, Y, Radius, 0); |
82 Y:= NewY |
101 cinfos[Gear.CollIndex]:= cinfos[Pred(Count)]; |
83 end |
102 cinfos[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex; |
84 end; |
103 Gear.CollIndex:= High(Longword); |
85 |
104 dec(Count) |
86 procedure DeleteCR(Gear: PGear); |
|
87 begin |
|
88 if Gear.CollIndex < Pred(Count) then |
|
89 begin |
|
90 crects[Gear.CollIndex]:= crects[Pred(Count)]; |
|
91 crects[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex |
|
92 end; |
105 end; |
93 Gear.CollIndex:= High(Longword); |
106 end; |
94 dec(Count) |
107 |
95 end; |
108 function CheckGearsCollision(Gear: PGear): PGearArray; |
96 |
109 var mx, my: integer; |
97 function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): PGear; |
|
98 var x1, x2, y1, y2: integer; |
|
99 i: Longword; |
110 i: Longword; |
100 begin |
111 begin |
101 Result:= nil; |
112 Result:= @ga; |
|
113 ga.Count:= 0; |
102 if Count = 0 then exit; |
114 if Count = 0 then exit; |
103 x1:= round(Gear.X); |
115 mx:= round(Gear.X); |
104 y1:= round(Gear.Y); |
116 my:= round(Gear.Y); |
105 |
|
106 if forX then |
|
107 begin |
|
108 x1:= x1 + Dir*Gear.HalfWidth; |
|
109 x2:= x1; |
|
110 y2:= y1 + Gear.HalfHeight - 1; |
|
111 y1:= y1 - Gear.HalfHeight + 1 |
|
112 end else |
|
113 begin |
|
114 y1:= y1 + Dir*Gear.HalfHeight; |
|
115 y2:= y1; |
|
116 x2:= x1 + Gear.HalfWidth - 1; |
|
117 x1:= x1 - Gear.HalfWidth + 1 |
|
118 end; |
|
119 |
117 |
120 for i:= 0 to Pred(Count) do |
118 for i:= 0 to Pred(Count) do |
121 with crects[i] do |
119 with cinfos[i] do |
122 if (Gear.CollIndex <> i) |
120 if (Gear <> cGear) and |
123 and (x1 <= X + HWidth) |
121 (sqrt(sqr(mx - x) + sqr(my - y)) <= Radius + Gear.Radius) then |
124 and (x2 >= X - HWidth) |
|
125 and (y1 <= Y + HHeight) |
|
126 and (y2 >= Y - HHeight) then |
|
127 begin |
122 begin |
128 Result:= crects[i].cGear; |
123 ga.ar[ga.Count]:= cinfos[i].cGear; |
129 exit |
124 inc(ga.Count) |
130 end; |
125 end; |
131 end; |
126 end; |
132 |
127 |
133 function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
128 function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
134 var x, y, i: integer; |
129 var x, y, i: integer; |
135 begin |
130 begin |
136 Result:= false; |
131 Result:= false; |
137 y:= round(Gear.Y); |
132 y:= round(Gear.Y); |
138 if Dir < 0 then y:= y - Gear.HalfHeight |
133 if Dir < 0 then y:= y - Gear.Radius |
139 else y:= y + Gear.HalfHeight; |
134 else y:= y + Gear.Radius; |
140 |
135 |
141 if ((y - Dir) and $FFFFFC00) = 0 then |
136 if ((y - Dir) and $FFFFFC00) = 0 then |
142 begin |
137 begin |
143 x:= round(Gear.X); |
138 x:= round(Gear.X); |
144 if (((x - Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.HalfWidth] <> 0) |
139 if (((x - Gear.Radius) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.Radius] <> 0) |
145 or(((x + Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.HalfWidth] <> 0) then |
140 or(((x + Gear.Radius) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.Radius] <> 0) then |
146 begin |
141 begin |
147 Result:= true; |
142 Result:= true; |
148 exit |
143 exit |
149 end |
144 end |
150 end; |
145 end; |
151 |
146 |
152 if (y and $FFFFFC00) = 0 then |
147 if (y and $FFFFFC00) = 0 then |
153 begin |
148 begin |
154 x:= round(Gear.X) - Gear.HalfWidth + 1; |
149 x:= round(Gear.X) - Gear.Radius + 1; |
155 i:= x + Gear.HalfWidth * 2 - 2; |
150 i:= x + Gear.Radius * 2 - 2; |
156 repeat |
151 repeat |
157 if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
152 if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
158 inc(x) |
153 inc(x) |
159 until (x > i) or Result; |
154 until (x > i) or Result |
160 if Result then exit; |
|
161 |
|
162 Result:= CheckGearsCollision(Gear, Dir, false) <> nil |
|
163 end |
155 end |
164 end; |
156 end; |
165 |
157 |
166 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
158 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
167 var x, y, i: integer; |
159 var x, y, i: integer; |
168 begin |
160 begin |
169 Result:= false; |
161 Result:= false; |
170 x:= round(Gear.X); |
162 x:= round(Gear.X); |
171 if Dir < 0 then x:= x - Gear.HalfWidth |
163 if Dir < 0 then x:= x - Gear.Radius |
172 else x:= x + Gear.HalfWidth; |
164 else x:= x + Gear.Radius; |
173 if (x and $FFFFF800) = 0 then |
165 if (x and $FFFFF800) = 0 then |
174 begin |
166 begin |
175 y:= round(Gear.Y) - Gear.HalfHeight + 1; {*} |
167 y:= round(Gear.Y) - Gear.Radius + 1; {*} |
176 i:= y + Gear.HalfHeight * 2 - 2; {*} |
168 i:= y + Gear.Radius * 2 - 2; {*} |
177 repeat |
169 repeat |
178 if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0; |
170 if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0; |
179 inc(y) |
171 inc(y) |
180 until (y > i) or Result; |
172 until (y > i) or Result; |
181 if Result then exit; |
|
182 Result:= CheckGearsCollision(Gear, Dir, true) <> nil |
|
183 end |
173 end |
184 end; |
174 end; |
185 |
175 |
186 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
176 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
187 begin |
177 begin |
195 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
185 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
196 var x, y, i: integer; |
186 var x, y, i: integer; |
197 begin |
187 begin |
198 Result:= false; |
188 Result:= false; |
199 y:= round(Gear.Y); |
189 y:= round(Gear.Y); |
200 if Dir < 0 then y:= y - Gear.HalfHeight |
190 if Dir < 0 then y:= y - Gear.Radius |
201 else y:= y + Gear.HalfHeight; |
191 else y:= y + Gear.Radius; |
202 if (y and $FFFFFC00) = 0 then |
192 if (y and $FFFFFC00) = 0 then |
203 begin |
193 begin |
204 x:= round(Gear.X) - Gear.HalfWidth + 1; {*} |
194 x:= round(Gear.X) - Gear.Radius + 1; {*} |
205 i:= x + Gear.HalfWidth * 2 - 2; {*} |
195 i:= x + Gear.Radius * 2 - 2; {*} |
206 repeat |
|
207 if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
|
208 inc(x) |
|
209 until (x > i) or Result; |
|
210 if Result then exit; |
|
211 Result:= CheckGearsCollision(Gear, Dir, false) <> nil; |
|
212 end |
|
213 end; |
|
214 |
|
215 function TestCollisionY(Gear: PGear; Dir: integer): boolean; |
|
216 var x, y, i: integer; |
|
217 begin |
|
218 Result:= false; |
|
219 y:= round(Gear.Y); |
|
220 if Dir < 0 then y:= y - Gear.HalfHeight |
|
221 else y:= y + Gear.HalfHeight; |
|
222 if (y and $FFFFFC00) = 0 then |
|
223 begin |
|
224 x:= round(Gear.X) - Gear.HalfWidth + 1; {*} |
|
225 i:= x + Gear.HalfWidth * 2 - 2; {*} |
|
226 repeat |
196 repeat |
227 if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
197 if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
228 inc(x) |
198 inc(x) |
229 until (x > i) or Result; |
199 until (x > i) or Result; |
230 end |
200 end |