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 procedure FindPoint(si: LongInt; var newPoint: TPoint; var pa: TPixAr); |
97 procedure FindPoint(si, fillPointsCount: LongInt; var newPoint: TPoint; var pa: TPixAr); |
98 const mapBorderMargin = 30; |
98 const mapBorderMargin = 30; |
99 minDistance = 32; |
99 minDistance = 32; // adjust/parametrize this for different details size |
100 var p1, p2, p4, fp, mp: TPoint; |
100 var p1, p2, p4, fp, mp: TPoint; |
101 i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt; |
101 i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt; |
102 dab, d, distL, distR: LongInt; |
102 dab, d, distL, distR: LongInt; |
103 begin |
103 begin |
104 // [p1, p2] is segment we're trying to divide |
104 // [p1, p2] is the segment we're trying to divide |
105 p1:= pa.ar[si]; |
105 p1:= pa.ar[si]; |
106 p2:= pa.ar[si + 1]; |
106 p2:= pa.ar[si + 1]; |
107 |
107 |
108 if p2.x = NTPX then |
108 if p2.x = NTPX then |
109 // it is segment from last to first point, so need to find first point |
109 // it is segment from last to first point, so need to find first point |
199 t1:= b * (mp.y - iy) + a * (mp.x - ix); |
199 t1:= b * (mp.y - iy) + a * (mp.x - ix); |
200 if t1 > 0 then distL:= min(d, distL) else distR:= min(d, distR); |
200 if t1 > 0 then distL:= min(d, distL) else distR:= min(d, distR); |
201 end; |
201 end; |
202 end; |
202 end; |
203 end; |
203 end; |
204 // go through all points |
204 |
205 for i:= 0 to pa.Count - 2 do |
205 // go through all points, including fill points |
|
206 for i:= 0 to pa.Count + fillPointsCount - 1 do |
206 // if this point isn't on current segment |
207 // if this point isn't on current segment |
207 if (si <> i) and (i <> si + 1) and (pa.ar[i].x <> NTPX) then |
208 if (si <> i) and (i <> si + 1) and (pa.ar[i].x <> NTPX) then |
208 begin |
209 begin |
209 // also check intersection with rays through pa.ar[i] if this point is good |
210 // also check intersection with rays through pa.ar[i] if this point is good |
210 t1:= (p1.x - pa.ar[i].x) * b - a * (p1.y - pa.ar[i].y); |
211 t1:= (p1.x - pa.ar[i].x) * b - a * (p1.y - pa.ar[i].y); |
250 end; |
251 end; |
251 end; |
252 end; |
252 end; |
253 end; |
253 |
254 |
254 // don't move new point for more than length of initial segment |
255 // don't move new point for more than length of initial segment |
|
256 // adjust/parametrize for more flat surfaces (try values 3/4, 1/2 of dab, or even 1/4) |
255 d:= dab; |
257 d:= dab; |
256 if distL > d then distL:= d; |
258 if distL > d then distL:= d; |
257 if distR > d then distR:= d; |
259 if distR > d then distR:= d; |
258 |
260 |
259 if distR + distL < minDistance * 2 + 10 then |
261 if distR + distL < minDistance * 2 + 10 then |
272 newPoint.x:= mp.x + a * d div dab; |
274 newPoint.x:= mp.x + a * d div dab; |
273 newPoint.y:= mp.y + b * d div dab; |
275 newPoint.y:= mp.y + b * d div dab; |
274 end; |
276 end; |
275 end; |
277 end; |
276 |
278 |
277 procedure DivideEdges(var pa: TPixAr); |
279 procedure DivideEdges(fillPointsCount: LongInt; var pa: TPixAr); |
278 var i, t: LongInt; |
280 var i, t: LongInt; |
279 newPoint: TPoint; |
281 newPoint: TPoint; |
280 begin |
282 begin |
281 i:= 0; |
283 i:= 0; |
282 |
284 |
283 while i < pa.Count - 1 do |
285 while i < pa.Count - 1 do |
284 begin |
286 begin |
285 FindPoint(i, newPoint, pa); |
287 FindPoint(i, fillPointsCount, newPoint, pa); |
|
288 |
286 if (newPoint.x <> pa.ar[i].x) or (newPoint.y <> pa.ar[i].y) then |
289 if (newPoint.x <> pa.ar[i].x) or (newPoint.y <> pa.ar[i].y) then |
287 begin |
290 begin |
288 for t:= pa.Count downto i + 2 do |
291 // point found, free a slot for it in array, don't forget to move appended fill points |
|
292 for t:= pa.Count + fillPointsCount downto i + 2 do |
289 pa.ar[t]:= pa.ar[t - 1]; |
293 pa.ar[t]:= pa.ar[t - 1]; |
290 inc(pa.Count); |
294 inc(pa.Count); |
291 pa.ar[i + 1]:= newPoint; |
295 pa.ar[i + 1]:= newPoint; |
292 inc(i) |
296 inc(i) |
293 end; |
297 end; |
294 inc(i) |
298 inc(i) |
295 end; |
299 end; |
296 end; |
300 end; |
297 |
301 |
298 procedure Distort2(var Template: TEdgeTemplate; var pa: TPixAr); |
302 procedure Distort2(var Template: TEdgeTemplate; fps: PPointArray; var pa: TPixAr); |
299 var i: Longword; |
303 var i: Longword; |
300 begin |
304 begin |
301 //for i:= 1 to Template.BezierizeCount do |
305 // append fill points to ensure distortion won't move them to other side of segment |
302 // DivideEdges(pa); |
306 for i:= 0 to pred(Template.FillPointsCount) do |
|
307 begin |
|
308 pa.ar[pa.Count + i].x:= fps^[i].x; |
|
309 pa.ar[pa.Count + i].y:= fps^[i].y; |
|
310 end; |
|
311 |
|
312 // divide while it divides |
303 repeat |
313 repeat |
304 i:= pa.Count; |
314 i:= pa.Count; |
305 DivideEdges(pa) |
315 DivideEdges(Template.FillPointsCount, pa) |
306 until i = pa.Count; |
316 until i = pa.Count; |
307 |
317 |
308 {for i:= 1 to Template.BezierizeCount do |
318 // make it smooth |
309 begin |
319 BezierizeEdge(pa, _0_2); |
310 BezierizeEdge(pa, _0_5); |
|
311 RandomizePoints(pa); |
|
312 RandomizePoints(pa) |
|
313 end; |
|
314 for i:= 1 to Template.RandPassesCount do |
|
315 RandomizePoints(pa);} |
|
316 BezierizeEdge(pa, _0_1); |
|
317 end; |
320 end; |
318 |
321 |
319 |
322 |
320 procedure GenTemplated(var Template: TEdgeTemplate); |
323 procedure GenTemplated(var Template: TEdgeTemplate); |
321 var pa: TPixAr; |
324 var pa: TPixAr; |
330 Land[y, x]:= lfBasic; |
333 Land[y, x]:= lfBasic; |
331 {$HINTS OFF} |
334 {$HINTS OFF} |
332 SetPoints(Template, pa, @fps); |
335 SetPoints(Template, pa, @fps); |
333 {$HINTS ON} |
336 {$HINTS ON} |
334 |
337 |
335 Distort2(Template, pa); |
338 Distort2(Template, @fps, pa); |
336 |
339 |
337 DrawEdge(pa, 0); |
340 DrawEdge(pa, 0); |
338 |
341 |
339 with Template do |
342 with Template do |
340 for i:= 0 to pred(FillPointsCount) do |
343 for i:= 0 to pred(FillPointsCount) do |