hedgewars/uLandGenTemplateBased.pas
changeset 10207 9dd3a44805a1
parent 10206 979a663d7351
child 10208 f04fdb35fc33
equal deleted inserted replaced
10206:979a663d7351 10207:9dd3a44805a1
    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