hedgewars/uLandGenTemplateBased.pas
changeset 10201 9bee9541edf1
parent 10200 edc2fe0ca03f
child 10202 f7c8cb11a70e
equal deleted inserted replaced
10200:edc2fe0ca03f 10201:9bee9541edf1
    94     BezierizeEdge(pa, _0_1);
    94     BezierizeEdge(pa, _0_1);
    95 end;
    95 end;
    96 
    96 
    97 
    97 
    98 procedure FindPoint(si: LongInt; var newPoint: TPoint; var pa: TPixAr);
    98 procedure FindPoint(si: LongInt; var newPoint: TPoint; var pa: TPixAr);
    99 const mapBorderMargin = 0;
    99 const mapBorderMargin = 30;
   100 var p1, p2, mp, ap: TPoint;
   100     minDistance = 20;
       
   101 var p1, p2, mp: TPoint;
   101     i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt;
   102     i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt;
   102     dab, d, distL, distR: LongInt;
   103     dab, d, distL, distR: LongInt;
   103 begin
   104 begin
   104     // [p1, p2] is segment we're trying to divide
   105     // [p1, p2] is segment we're trying to divide
   105     p1:= pa.ar[si];
   106     p1:= pa.ar[si];
   106     p2:= pa.ar[si + 1];
   107     p2:= pa.ar[si + 1];
   107 
   108     writeln('====================== ', p1.x, '; ', p1.y, ' --- ', p2.x, '; ', p2.y);
   108     if (p1.x = NTPX) or (p2.x = NTPX) then
   109 
       
   110     // perpendicular vector
       
   111     a:= p2.y - p1.y;
       
   112     b:= p1.x - p2.x;
       
   113     dab:= DistanceI(a, b).Round;
       
   114 
       
   115     if (p1.x = NTPX) or (p2.x = NTPX) or (dab < minDistance * 3) then
   109     begin
   116     begin
   110         newPoint:= p1;
   117         newPoint:= p1;
   111         exit;
   118         exit;
   112     end;
   119     end;
   113 
   120 
   114     // its middle point
   121     // its middle point
   115     mp.x:= (p1.x + p2.x) div 2;
   122     mp.x:= (p1.x + p2.x) div 2;
   116     mp.y:= (p1.y + p2.y) div 2;
   123     mp.y:= (p1.y + p2.y) div 2;
   117     // another point on the perpendicular bisector
       
   118     ap.x:= mp.x + p2.y - p1.y;
       
   119     ap.y:= mp.y + p1.x - p2.x;
       
   120     // vector between these points
       
   121     a:= p2.y - p1.y;
       
   122     b:= p1.x - p2.x;
       
   123 
   124 
   124     // find distances to map borders
   125     // find distances to map borders
   125     if a <> 0 then
   126     if a <> 0 then
   126     begin
   127     begin
   127         // left border
   128         // left border
   128         iy:= (mapBorderMargin - mp.x) * b div a + mp.y;
   129         iy:= (mapBorderMargin - mp.x) * b div a + mp.y;
   129         d:= DistanceI(mp.x - mapBorderMargin, mp.y - iy).Round;
   130         d:= DistanceI(mp.x - mapBorderMargin, mp.y - iy).Round;
   130         t1:= a * (mp.x - mapBorderMargin) + b * (mp.y - iy);
   131         t1:= a * (mp.x - mapBorderMargin) + b * (mp.y - iy);
   131         if t1 > 0 then distL:= d else distR:= d;
   132         if t1 > 0 then distL:= d else distR:= d;
   132                     writeln('====== Left border: ', mapBorderMargin, '; ', mp.y - iy, ', distance = ', d);
       
   133                     writeln(a, ' ', -b);
       
   134                     writeln(t1);
       
   135                     writeln(mp.x - mapBorderMargin, ' ', mp.y - iy);
       
   136                     writeln('MP: ', mp.x, ' ', mp.y);
       
   137                     writeln('L: ', distL, '; R: ', distR);
       
   138 
   133 
   139         // right border
   134         // right border
   140         iy:= (LAND_WIDTH - mapBorderMargin - mp.x) * b div a + mp.y;
   135         iy:= (LAND_WIDTH - mapBorderMargin - mp.x) * b div a + mp.y;
   141         d:= DistanceI(mp.x - LAND_WIDTH + mapBorderMargin, mp.y - iy).Round;
   136         d:= DistanceI(mp.x - LAND_WIDTH + mapBorderMargin, mp.y - iy).Round;
   142         if t1 > 0 then distR:= d else distL:= d;
   137         if t1 > 0 then distR:= d else distL:= d;
   152 
   147 
   153         // bottom border
   148         // bottom border
   154         ix:= (LAND_HEIGHT - mapBorderMargin - mp.y) * a div b + mp.x;
   149         ix:= (LAND_HEIGHT - mapBorderMargin - mp.y) * a div b + mp.x;
   155         d:= DistanceI(mp.y - LAND_HEIGHT + mapBorderMargin, mp.x - ix).Round;
   150         d:= DistanceI(mp.y - LAND_HEIGHT + mapBorderMargin, mp.x - ix).Round;
   156         if t2 > 0 then distR:= min(d, distR) else distL:= min(d, distL);
   151         if t2 > 0 then distR:= min(d, distR) else distL:= min(d, distL);
   157                     writeln('====== Bottom border: ', ix, '; ', LAND_HEIGHT - mapBorderMargin, ', distance = ', d);
       
   158                     writeln(a, ' ', -b);
       
   159                     writeln(t2);
       
   160                     writeln(mp.x - ix, ' ', mp.y - LAND_HEIGHT + mapBorderMargin);
       
   161                     writeln('L: ', distL, '; R: ', distR);
       
   162     end;
   152     end;
   163 
   153 
   164     // now go through all other segments
   154     // now go through all other segments
   165     for i:= 0 to pa.Count - 2 do
   155     for i:= 0 to pa.Count - 2 do
   166         if (i <> si) and (pa.ar[i].x <> NTPX) and (pa.ar[i + 1].x <> NTPX) then
   156         if (i <> si) and (pa.ar[i].x <> NTPX) and (pa.ar[i + 1].x <> NTPX) then
   176                 aqpb:= a * q - p * b;
   166                 aqpb:= a * q - p * b;
   177 
   167 
   178                 if (aqpb <> 0) then
   168                 if (aqpb <> 0) then
   179                 begin
   169                 begin
   180                     // (ix; iy) is intersection point
   170                     // (ix; iy) is intersection point
   181                     iy:= (((pa.ar[i].x - mp.x) * b + mp.y * a) * q - pa.ar[i].y * p * b);
   171                     iy:= (((pa.ar[i].x - mp.x) * b + mp.y * a) * q - pa.ar[i].y * p * b) div aqpb;
   182                     if b <> 0 then
   172                     if abs(b) > abs(q) then
   183                         ix:= (iy - mp.y * aqpb) * a div b div aqpb + mp.x
   173                         ix:= (iy - mp.y) * a div b + mp.x
   184                     else
   174                     else
   185                         ix:= (iy - pa.ar[i].y * aqpb) * p div q div aqpb + pa.ar[i].x;
   175                         ix:= (iy - pa.ar[i].y) * p div q + pa.ar[i].x;
   186                     iy:= iy div aqpb;
       
   187 
   176 
   188                     d:= DistanceI(mp.y - iy, mp.x - ix).Round;
   177                     d:= DistanceI(mp.y - iy, mp.x - ix).Round;
   189                     writeln('====== Intersection: ', ix, '; ', iy, ', distance = ', d);
       
   190                     t1:= b * (mp.y - iy) + a * (mp.x - ix);
   178                     t1:= b * (mp.y - iy) + a * (mp.x - ix);
   191                     writeln(a, ' ', -b);
       
   192                     writeln(t1);
       
   193                     writeln(mp.y - iy, ' ', mp.x - ix);
       
   194                     if t1 > 0 then distL:= min(d, distL) else distR:= min(d, distR);
   179                     if t1 > 0 then distL:= min(d, distL) else distR:= min(d, distR);
   195                     writeln('L: ', distL, '; R: ', distR);
       
   196                 end;
   180                 end;
   197             end;
   181             end;
   198         end;
   182         end;
   199 
   183 
   200     if distR + distL < 40 then
   184 
       
   185     // don't move new point for more than 3/4 length of initial segment
       
   186     d:= dab * 3 div 4;
       
   187     if distL > d then distL:= d;
       
   188     if distR > d then distR:= d;
       
   189 
       
   190     if distR + distL < minDistance * 2 then
   201     begin
   191     begin
   202         // limits are too narrow, leave point alone
   192         // limits are too narrow, leave point alone
   203         newPoint:= p1
   193         newPoint:= p1
   204     end
   194     end
   205     else
   195     else
   206     begin
   196     begin
   207         // select distance within [-distL; distR]
   197         // select distance within [-distL; distR]
   208         d:= -distL;
   198         d:= -distL + minDistance + GetRandom(distR + distL - minDistance * 2);
   209         //d:= distR;
   199         //d:= distR - minDistance;
   210 
   200 
   211         // calculate new point
   201         // calculate new point
   212         dab:= DistanceI(a, b).Round;
       
   213 
       
   214         newPoint.x:= mp.x + a * d div dab;
   202         newPoint.x:= mp.x + a * d div dab;
   215         newPoint.y:= mp.y + b * d div dab;
   203         newPoint.y:= mp.y + b * d div dab;
   216 
   204 
   217         writeln('Middle Point ', mp.x, '; ', mp.y);
       
   218         writeln('New Point ', newPoint.x, '; ', newPoint.y);
   205         writeln('New Point ', newPoint.x, '; ', newPoint.y);
   219     end;
   206     end;
   220 end;
   207 end;
   221 
   208 
   222 procedure DivideEdges(var pa: TPixAr);
   209 procedure DivideEdges(var pa: TPixAr);
   229     while i < pa.Count do
   216     while i < pa.Count do
   230     begin
   217     begin
   231         npa.ar[npa.Count]:= pa.ar[i];
   218         npa.ar[npa.Count]:= pa.ar[i];
   232         inc(npa.Count);
   219         inc(npa.Count);
   233 
   220 
   234         if i < 1 then
   221         if i < pa.Count - 1 then
   235         begin
   222         begin
   236             FindPoint(i, newPoint, pa);
   223             FindPoint(i, newPoint, pa);
   237             if (newPoint.x <> pa.ar[i].x) or (newPoint.y <> pa.ar[i].y) then
   224             if (newPoint.x <> pa.ar[i].x) or (newPoint.y <> pa.ar[i].y) then
   238             begin
   225             begin
   239             npa.ar[npa.Count]:= newPoint;
   226             npa.ar[npa.Count]:= newPoint;
   246 
   233 
   247     pa:= npa;
   234     pa:= npa;
   248 end;
   235 end;
   249 
   236 
   250 procedure Distort2(var Template: TEdgeTemplate; var pa: TPixAr);
   237 procedure Distort2(var Template: TEdgeTemplate; var pa: TPixAr);
   251 //var i: Longword;
   238 var i: Longword;
   252 begin
   239 begin
   253     DivideEdges(pa);
   240     for i:= 1 to Template.BezierizeCount do
       
   241         DivideEdges(pa);
       
   242 
   254     {for i:= 1 to Template.BezierizeCount do
   243     {for i:= 1 to Template.BezierizeCount do
   255         begin
   244         begin
   256         BezierizeEdge(pa, _0_5);
   245         BezierizeEdge(pa, _0_5);
   257         RandomizePoints(pa);
   246         RandomizePoints(pa);
   258         RandomizePoints(pa)
   247         RandomizePoints(pa)
   259         end;
   248         end;
   260     for i:= 1 to Template.RandPassesCount do
   249     for i:= 1 to Template.RandPassesCount do
   261         RandomizePoints(pa);}
   250         RandomizePoints(pa);}
   262     BezierizeEdge(pa, _0_9);
   251     BezierizeEdge(pa, _0_1);
   263 end;
   252 end;
   264 
   253 
   265 
   254 
   266 procedure GenTemplated(var Template: TEdgeTemplate);
   255 procedure GenTemplated(var Template: TEdgeTemplate);
   267 var pa: TPixAr;
   256 var pa: TPixAr;