32 procedure DeleteCI(Gear: PGear); |
32 procedure DeleteCI(Gear: PGear); |
33 function CheckGearsCollision(Gear: PGear): PGearArray; |
33 function CheckGearsCollision(Gear: PGear): PGearArray; |
34 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
34 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
35 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
35 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
36 function TestCollisionY(Gear: PGear; Dir: integer): boolean; |
36 function TestCollisionY(Gear: PGear; Dir: integer): boolean; |
37 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: Double; Dir: integer): boolean; |
37 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: hwFloat; Dir: integer): boolean; |
38 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
38 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
39 |
39 |
40 implementation |
40 implementation |
41 uses uMisc, uConsts, uLand, uLandGraphics; |
41 uses uMisc, uConsts, uLand, uLandGraphics; |
42 |
42 |
43 type TCollisionEntry = record |
43 type TCollisionEntry = record |
44 X, Y, Radius: integer; |
44 X, Y, Radius: integer; |
45 cGear: PGear; |
45 cGear: PGear; |
46 end; |
46 end; |
47 |
47 |
48 const MAXRECTSINDEX = 255; |
48 const MAXRECTSINDEX = 255; |
49 var Count: Longword = 0; |
49 var Count: Longword = 0; |
50 cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry; |
50 cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry; |
51 ga: TGearArray; |
51 ga: TGearArray; |
52 |
52 |
53 procedure AddGearCI(Gear: PGear); |
53 procedure AddGearCI(Gear: PGear); |
54 begin |
54 begin |
55 if Gear.CollIndex < High(Longword) then exit; |
55 if Gear^.CollIndex < High(Longword) then exit; |
56 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true); |
56 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true); |
57 with cinfos[Count] do |
57 with cinfos[Count] do |
58 begin |
58 begin |
59 X:= round(Gear.X); |
59 X:= hwRound(Gear^.X); |
60 Y:= round(Gear.Y); |
60 Y:= hwRound(Gear^.Y); |
61 Radius:= Gear.Radius; |
61 Radius:= Gear^.Radius; |
62 FillRoundInLand(X, Y, Radius-1, $FF); |
62 FillRoundInLand(X, Y, Radius-1, $FF); |
63 cGear:= Gear |
63 cGear:= Gear |
64 end; |
64 end; |
65 Gear.CollIndex:= Count; |
65 Gear^.CollIndex:= Count; |
66 inc(Count) |
66 inc(Count) |
67 end; |
67 end; |
68 |
68 |
69 procedure DeleteCI(Gear: PGear); |
69 procedure DeleteCI(Gear: PGear); |
70 begin |
70 begin |
71 if Gear.CollIndex < Count then |
71 if Gear^.CollIndex < Count then |
72 begin |
72 begin |
73 with cinfos[Gear.CollIndex] do FillRoundInLand(X, Y, Radius-1, 0); |
73 with cinfos[Gear^.CollIndex] do FillRoundInLand(X, Y, Radius-1, 0); |
74 cinfos[Gear.CollIndex]:= cinfos[Pred(Count)]; |
74 cinfos[Gear^.CollIndex]:= cinfos[Pred(Count)]; |
75 cinfos[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex; |
75 cinfos[Gear^.CollIndex].cGear^.CollIndex:= Gear^.CollIndex; |
76 Gear.CollIndex:= High(Longword); |
76 Gear^.CollIndex:= High(Longword); |
77 dec(Count) |
77 dec(Count) |
78 end; |
78 end; |
79 end; |
79 end; |
80 |
80 |
81 function CheckGearsCollision(Gear: PGear): PGearArray; |
81 function CheckGearsCollision(Gear: PGear): PGearArray; |
82 var mx, my: integer; |
82 var mx, my: integer; |
83 i: Longword; |
83 i: Longword; |
|
84 Result: PGearArray; |
84 begin |
85 begin |
85 Result:= @ga; |
86 Result:= @ga; |
86 ga.Count:= 0; |
87 ga.Count:= 0; |
87 if Count = 0 then exit; |
88 if Count = 0 then exit; |
88 mx:= round(Gear.X); |
89 mx:= hwRound(Gear^.X); |
89 my:= round(Gear.Y); |
90 my:= hwRound(Gear^.Y); |
90 |
91 |
91 for i:= 0 to Pred(Count) do |
92 for i:= 0 to Pred(Count) do |
92 with cinfos[i] do |
93 with cinfos[i] do |
93 if (Gear <> cGear) and |
94 if (Gear <> cGear) and |
94 (sqrt(sqr(mx - x) + sqr(my - y)) <= Radius + Gear.Radius) then |
95 (sqrt(sqr(mx - x) + sqr(my - y)) <= Radius + Gear^.Radius) then |
95 begin |
96 begin |
96 ga.ar[ga.Count]:= cinfos[i].cGear; |
97 ga.ar[ga.Count]:= cinfos[i].cGear; |
97 inc(ga.Count) |
98 inc(ga.Count) |
98 end; |
99 end; |
|
100 CheckGearsCollision:= Result |
99 end; |
101 end; |
100 |
102 |
101 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
103 function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; |
102 var x, y, i: integer; |
104 var x, y, i: integer; |
103 begin |
105 begin |
104 Result:= false; |
106 x:= hwRound(Gear^.X); |
105 x:= round(Gear.X); |
107 if Dir < 0 then x:= x - Gear^.Radius |
106 if Dir < 0 then x:= x - Gear.Radius |
108 else x:= x + Gear^.Radius; |
107 else x:= x + Gear.Radius; |
|
108 if (x and $FFFFF800) = 0 then |
109 if (x and $FFFFF800) = 0 then |
109 begin |
110 begin |
110 y:= round(Gear.Y) - Gear.Radius + 1; |
111 y:= hwRound(Gear^.Y) - Gear^.Radius + 1; |
111 i:= y + Gear.Radius * 2 - 2; |
112 i:= y + Gear^.Radius * 2 - 2; |
112 repeat |
113 repeat |
113 if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0; |
114 if (y and $FFFFFC00) = 0 then |
|
115 if Land[y, x] <> 0 then exit(true); |
114 inc(y) |
116 inc(y) |
115 until (y > i) or Result; |
117 until (y > i); |
116 end |
118 end; |
|
119 TestCollisionXwithGear:= false |
117 end; |
120 end; |
118 |
121 |
119 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: Double; Dir: integer): boolean; |
122 function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: hwFloat; Dir: integer): boolean; |
120 begin |
123 begin |
121 Gear.X:= Gear.X + ShiftX; |
124 Gear^.X:= Gear^.X + ShiftX; |
122 Gear.Y:= Gear.Y + ShiftY; |
125 Gear^.Y:= Gear^.Y + ShiftY; |
123 Result:= TestCollisionXwithGear(Gear, Dir); |
126 TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir); |
124 Gear.X:= Gear.X - ShiftX; |
127 Gear^.X:= Gear^.X - ShiftX; |
125 Gear.Y:= Gear.Y - ShiftY |
128 Gear^.Y:= Gear^.Y - ShiftY |
126 end; |
129 end; |
127 |
130 |
128 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
131 function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; |
129 var x, y, i: integer; |
132 var x, y, i: integer; |
130 begin |
133 begin |
131 Result:= false; |
134 y:= hwRound(Gear^.Y); |
132 y:= round(Gear.Y); |
135 if Dir < 0 then y:= y - Gear^.Radius |
133 if Dir < 0 then y:= y - Gear.Radius |
136 else y:= y + Gear^.Radius; |
134 else y:= y + Gear.Radius; |
|
135 if (y and $FFFFFC00) = 0 then |
137 if (y and $FFFFFC00) = 0 then |
136 begin |
138 begin |
137 x:= round(Gear.X) - Gear.Radius + 1; |
139 x:= hwRound(Gear^.X) - Gear^.Radius + 1; |
138 i:= x + Gear.Radius * 2 - 2; |
140 i:= x + Gear^.Radius * 2 - 2; |
139 repeat |
141 repeat |
140 if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; |
142 if (x and $FFFFF800) = 0 then |
|
143 if Land[y, x] <> 0 then exit(true); |
141 inc(x) |
144 inc(x) |
142 until (x > i) or Result; |
145 until (x > i); |
143 end |
146 end; |
|
147 TestCollisionYwithGear:= false |
144 end; |
148 end; |
145 |
149 |
146 function TestCollisionY(Gear: PGear; Dir: integer): boolean; |
150 function TestCollisionY(Gear: PGear; Dir: integer): boolean; |
147 var x, y, i: integer; |
151 var x, y, i: integer; |
148 begin |
152 begin |
149 Result:= false; |
153 y:= hwRound(Gear^.Y); |
150 y:= round(Gear.Y); |
154 if Dir < 0 then y:= y - Gear^.Radius |
151 if Dir < 0 then y:= y - Gear.Radius |
155 else y:= y + Gear^.Radius; |
152 else y:= y + Gear.Radius; |
|
153 if (y and $FFFFFC00) = 0 then |
156 if (y and $FFFFFC00) = 0 then |
154 begin |
157 begin |
155 x:= round(Gear.X) - Gear.Radius + 1; |
158 x:= hwRound(Gear^.X) - Gear^.Radius + 1; |
156 i:= x + Gear.Radius * 2 - 2; |
159 i:= x + Gear^.Radius * 2 - 2; |
157 repeat |
160 repeat |
158 if (x and $FFFFF800) = 0 then Result:= Land[y, x] = COLOR_LAND; |
161 if (x and $FFFFF800) = 0 then |
|
162 if Land[y, x] = COLOR_LAND then exit(true); |
159 inc(x) |
163 inc(x) |
160 until (x > i) or Result; |
164 until (x > i); |
161 end |
165 end; |
|
166 TestCollisionY:= false |
162 end; |
167 end; |
163 |
168 |
164 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
169 function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; |
165 begin |
170 begin |
166 Gear.X:= Gear.X + ShiftX; |
171 Gear^.X:= Gear^.X + ShiftX; |
167 Gear.Y:= Gear.Y + ShiftY; |
172 Gear^.Y:= Gear^.Y + ShiftY; |
168 Result:= TestCollisionYwithGear(Gear, Dir); |
173 TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir); |
169 Gear.X:= Gear.X - ShiftX; |
174 Gear^.X:= Gear^.X - ShiftX; |
170 Gear.Y:= Gear.Y - ShiftY |
175 Gear^.Y:= Gear^.Y - ShiftY |
171 end; |
176 end; |
172 |
177 |
173 end. |
178 end. |