92 for i:= 1 to Template.RandPassesCount do |
92 for i:= 1 to Template.RandPassesCount do |
93 RandomizePoints(pa); |
93 RandomizePoints(pa); |
94 BezierizeEdge(pa, _0_1); |
94 BezierizeEdge(pa, _0_1); |
95 end; |
95 end; |
96 |
96 |
97 |
|
98 procedure FindPoint(si: LongInt; var newPoint: TPoint; var pa: TPixAr); |
97 procedure FindPoint(si: LongInt; var newPoint: TPoint; var pa: TPixAr); |
99 const mapBorderMargin = 30; |
98 const mapBorderMargin = 30; |
100 minDistance = 20; |
99 minDistance = 20; |
101 var p1, p2, mp: TPoint; |
100 var p1, p2, mp: TPoint; |
102 i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt; |
101 i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt; |
103 dab, d, distL, distR: LongInt; |
102 dab, d, distL, distR: LongInt; |
104 begin |
103 begin |
105 // [p1, p2] is segment we're trying to divide |
104 // [p1, p2] is segment we're trying to divide |
106 p1:= pa.ar[si]; |
105 p1:= pa.ar[si]; |
107 p2:= pa.ar[si + 1]; |
106 p2:= pa.ar[si + 1]; |
108 writeln('====================== ', p1.x, '; ', p1.y, ' --- ', p2.x, '; ', p2.y); |
|
109 |
107 |
110 // perpendicular vector |
108 // perpendicular vector |
111 a:= p2.y - p1.y; |
109 a:= p2.y - p1.y; |
112 b:= p1.x - p2.x; |
110 b:= p1.x - p2.x; |
113 dab:= DistanceI(a, b).Round; |
111 dab:= DistanceI(a, b).Round; |
179 if t1 > 0 then distL:= min(d, distL) else distR:= min(d, distR); |
177 if t1 > 0 then distL:= min(d, distL) else distR:= min(d, distR); |
180 end; |
178 end; |
181 end; |
179 end; |
182 end; |
180 end; |
183 |
181 |
184 |
182 // go through all points |
185 // don't move new point for more than 3/4 length of initial segment |
183 for i:= 0 to pa.Count - 2 do |
186 d:= dab * 3 div 4; |
184 // if this point isn't on current segment |
|
185 if (si <> i) and (i <> si + 1) then |
|
186 begin |
|
187 // also check intersection with rays through pa.ar[i] if this point is good |
|
188 t1:= (p1.x - pa.ar[i].x) * b - a * (p1.y - pa.ar[i].y); |
|
189 t2:= (p2.x - pa.ar[i].x) * b - a * (p2.y - pa.ar[i].y); |
|
190 if (t1 > 0) <> (t2 > 0) then |
|
191 begin |
|
192 // ray from p1 |
|
193 p:= pa.ar[i].x - p1.x; |
|
194 q:= pa.ar[i].y - p1.y; |
|
195 aqpb:= a * q - p * b; |
|
196 |
|
197 if (aqpb <> 0) then |
|
198 begin |
|
199 // (ix; iy) is intersection point |
|
200 iy:= (((p1.x - mp.x) * b + mp.y * a) * q - p1.y * p * b) div aqpb; |
|
201 if abs(b) > abs(q) then |
|
202 ix:= (iy - mp.y) * a div b + mp.x |
|
203 else |
|
204 ix:= (iy - p1.y) * p div q + p1.x; |
|
205 |
|
206 d:= DistanceI(mp.y - iy, mp.x - ix).Round; |
|
207 t1:= b * (mp.y - iy) + a * (mp.x - ix); |
|
208 if t1 > 0 then distL:= min(d, distL) else distR:= min(d, distR); |
|
209 end; |
|
210 |
|
211 // and ray from p2 |
|
212 p:= pa.ar[i].x - p2.x; |
|
213 q:= pa.ar[i].y - p2.y; |
|
214 aqpb:= a * q - p * b; |
|
215 |
|
216 if (aqpb <> 0) then |
|
217 begin |
|
218 // (ix; iy) is intersection point |
|
219 iy:= (((p2.x - mp.x) * b + mp.y * a) * q - p2.y * p * b) div aqpb; |
|
220 if abs(b) > abs(q) then |
|
221 ix:= (iy - mp.y) * a div b + mp.x |
|
222 else |
|
223 ix:= (iy - p2.y) * p div q + p2.x; |
|
224 |
|
225 d:= DistanceI(mp.y - iy, mp.x - ix).Round; |
|
226 t2:= b * (mp.y - iy) + a * (mp.x - ix); |
|
227 if t2 > 0 then distL:= min(d, distL) else distR:= min(d, distR); |
|
228 end; |
|
229 end; |
|
230 end; |
|
231 |
|
232 // don't move new point for more than length of initial segment |
|
233 d:= dab; |
187 if distL > d then distL:= d; |
234 if distL > d then distL:= d; |
188 if distR > d then distR:= d; |
235 if distR > d then distR:= d; |
189 |
236 |
190 if distR + distL < minDistance * 2 then |
237 if distR + distL < minDistance * 2 then |
191 begin |
238 begin |
195 else |
242 else |
196 begin |
243 begin |
197 // select distance within [-distL; distR] |
244 // select distance within [-distL; distR] |
198 d:= -distL + minDistance + GetRandom(distR + distL - minDistance * 2); |
245 d:= -distL + minDistance + GetRandom(distR + distL - minDistance * 2); |
199 //d:= distR - minDistance; |
246 //d:= distR - minDistance; |
|
247 //d:= - distL + minDistance; |
200 |
248 |
201 // calculate new point |
249 // calculate new point |
202 newPoint.x:= mp.x + a * d div dab; |
250 newPoint.x:= mp.x + a * d div dab; |
203 newPoint.y:= mp.y + b * d div dab; |
251 newPoint.y:= mp.y + b * d div dab; |
204 |
|
205 writeln('New Point ', newPoint.x, '; ', newPoint.y); |
|
206 end; |
252 end; |
207 end; |
253 end; |
208 |
254 |
209 procedure DivideEdges(var pa: TPixAr); |
255 procedure DivideEdges(var pa: TPixAr); |
210 var npa: TPixAr; |
256 var i, t: LongInt; |
211 i: LongInt; |
|
212 newPoint: TPoint; |
257 newPoint: TPoint; |
213 begin |
258 begin |
214 i:= 0; |
259 i:= 0; |
215 npa.Count:= 0; |
260 |
216 while i < pa.Count do |
261 while i < pa.Count - 1 do |
217 begin |
262 begin |
218 npa.ar[npa.Count]:= pa.ar[i]; |
263 FindPoint(i, newPoint, pa); |
219 inc(npa.Count); |
264 if (newPoint.x <> pa.ar[i].x) or (newPoint.y <> pa.ar[i].y) then |
220 |
265 begin |
221 if i < pa.Count - 1 then |
266 for t:= pa.Count downto i + 2 do |
222 begin |
267 pa.ar[t]:= pa.ar[t - 1]; |
223 FindPoint(i, newPoint, pa); |
268 inc(pa.Count); |
224 if (newPoint.x <> pa.ar[i].x) or (newPoint.y <> pa.ar[i].y) then |
269 pa.ar[i + 1]:= newPoint; |
225 begin |
270 inc(i) |
226 npa.ar[npa.Count]:= newPoint; |
271 end; |
227 inc(npa.Count) |
|
228 end; |
|
229 end; |
|
230 |
|
231 inc(i) |
272 inc(i) |
232 end; |
273 end; |
233 |
|
234 pa:= npa; |
|
235 end; |
274 end; |
236 |
275 |
237 procedure Distort2(var Template: TEdgeTemplate; var pa: TPixAr); |
276 procedure Distort2(var Template: TEdgeTemplate; var pa: TPixAr); |
238 var i: Longword; |
277 var i: Longword; |
239 begin |
278 begin |
265 Land[y, x]:= lfBasic; |
304 Land[y, x]:= lfBasic; |
266 {$HINTS OFF} |
305 {$HINTS OFF} |
267 SetPoints(Template, pa, @fps); |
306 SetPoints(Template, pa, @fps); |
268 {$HINTS ON} |
307 {$HINTS ON} |
269 |
308 |
270 Distort1(Template, pa); |
309 Distort2(Template, pa); |
271 |
310 |
272 DrawEdge(pa, 0); |
311 DrawEdge(pa, 0); |
273 |
312 |
274 with Template do |
313 with Template do |
275 for i:= 0 to pred(FillPointsCount) do |
314 for i:= 0 to pred(FillPointsCount) do |