hedgewars/uLandGenTemplateBased.pas
changeset 10209 76316652ef26
parent 10208 f04fdb35fc33
child 10225 0278759252b6
equal deleted inserted replaced
10208:f04fdb35fc33 10209:76316652ef26
    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, fillPointsCount: LongInt; var newPoint: TPoint; var pa: TPixAr);
    97 procedure FindPoint(si: LongInt; fillPointsCount: LongWord; var newPoint: TPoint; var pa: TPixAr);
    98 const mapBorderMargin = 40;
    98 const mapBorderMargin = 40;
    99     minDistance = 32; // adjust/parametrize this for different details size
    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;
   124     mp.y:= (p1.y + p2.y) div 2;
   124     mp.y:= (p1.y + p2.y) div 2;
   125 
   125 
   126     // don't process too short segments or those which are too close to map borders
   126     // don't process too short segments or those which are too close to map borders
   127     if (p1.x = NTPX)
   127     if (p1.x = NTPX)
   128             or (dab < minDistance * 3) 
   128             or (dab < minDistance * 3) 
   129             or (mp.x < leftX + mapBorderMargin)
   129             or (mp.x < LongInt(leftX) + mapBorderMargin)
   130             or (mp.x > rightX - mapBorderMargin)
   130             or (mp.x > LongInt(rightX) - mapBorderMargin)
   131             or (mp.y < topY + mapBorderMargin)
   131             or (mp.y < LongInt(topY) + mapBorderMargin)
   132             or (mp.y > LAND_HEIGHT - mapBorderMargin)
   132             or (mp.y > LongInt(LAND_HEIGHT) - mapBorderMargin)
   133     then
   133     then
   134     begin
   134     begin
   135         newPoint:= p1;
   135         newPoint:= p1;
   136         exit;
   136         exit;
   137     end;
   137     end;
   138 
   138 
   139     // find distances to map borders
   139     // find distances to map borders
   140     if a <> 0 then
   140     if a <> 0 then
   141     begin
   141     begin
   142         // left border
   142         // left border
   143         iy:= (leftX + mapBorderMargin - mp.x) * b div a + mp.y;
   143         iy:= (LongInt(leftX) + mapBorderMargin - mp.x) * b div a + mp.y;
   144         d:= DistanceI(mp.x - leftX - mapBorderMargin, mp.y - iy).Round;
   144         d:= DistanceI(mp.x - leftX - mapBorderMargin, mp.y - iy).Round;
   145         t1:= a * (mp.x - mapBorderMargin) + b * (mp.y - iy);
   145         t1:= a * (mp.x - mapBorderMargin) + b * (mp.y - iy);
   146         if t1 > 0 then distL:= d else distR:= d;
   146         if t1 > 0 then distL:= d else distR:= d;
   147 
   147 
   148         // right border
   148         // right border
   152     end;
   152     end;
   153 
   153 
   154     if b <> 0 then
   154     if b <> 0 then
   155     begin
   155     begin
   156         // top border
   156         // top border
   157         ix:= (topY + mapBorderMargin - mp.y) * a div b + mp.x;
   157         ix:= (LongInt(topY) + mapBorderMargin - mp.y) * a div b + mp.x;
   158         d:= DistanceI(mp.y - topY - mapBorderMargin, mp.x - ix).Round;
   158         d:= DistanceI(mp.y - topY - mapBorderMargin, mp.x - ix).Round;
   159         t2:= b * (mp.y - mapBorderMargin) + a * (mp.x - ix);
   159         t2:= b * (mp.y - mapBorderMargin) + a * (mp.x - ix);
   160         if t2 > 0 then distL:= min(d, distL) else distR:= min(d, distR);
   160         if t2 > 0 then distL:= min(d, distL) else distR:= min(d, distR);
   161 
   161 
   162         // bottom border
   162         // bottom border
   201                 end;
   201                 end;
   202             end;
   202             end;
   203         end;
   203         end;
   204 
   204 
   205     // go through all points, including fill points
   205     // go through all points, including fill points
   206     for i:= 0 to pa.Count + fillPointsCount - 1 do
   206     for i:= 0 to Pred(pa.Count + fillPointsCount) do
   207         // if this point isn't on current segment
   207         // if this point isn't on current segment
   208         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
   209         begin
   209         begin
   210             // 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
   211             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);
   264         newPoint:= p1
   264         newPoint:= p1
   265     end
   265     end
   266     else
   266     else
   267     begin
   267     begin
   268         // select distance within [-distL; distR]
   268         // select distance within [-distL; distR]
   269         d:= -distL + minDistance + GetRandom(distR + distL - minDistance * 2);
   269         d:= -distL + minDistance + LongInt(GetRandom(distR + distL - minDistance * 2));
   270         //d:= distR - minDistance;
   270         //d:= distR - minDistance;
   271         //d:= - distL + minDistance;
   271         //d:= - distL + minDistance;
   272 
   272 
   273         // calculate new point
   273         // calculate new point
   274         newPoint.x:= mp.x + a * d div dab;
   274         newPoint.x:= mp.x + a * d div dab;
   275         newPoint.y:= mp.y + b * d div dab;
   275         newPoint.y:= mp.y + b * d div dab;
   276     end;
   276     end;
   277 end;
   277 end;
   278 
   278 
   279 procedure DivideEdges(fillPointsCount: LongInt; var pa: TPixAr);
   279 procedure DivideEdges(fillPointsCount: LongWord; var pa: TPixAr);
   280 var i, t: LongInt;
   280 var i, t: LongInt;
   281     newPoint: TPoint;
   281     newPoint: TPoint;
   282 begin
   282 begin
       
   283     newPoint.x:= 0;
       
   284     newPoint.y:= 0;
   283     i:= 0;
   285     i:= 0;
   284 
   286 
   285     while i < pa.Count - 1 do
   287     while i < pa.Count - 1 do
   286     begin
   288     begin
   287         FindPoint(i, fillPointsCount, newPoint, pa);
   289         FindPoint(i, fillPointsCount, newPoint, pa);
   335     MaxHedgehogs:= Template.MaxHedgehogs;
   337     MaxHedgehogs:= Template.MaxHedgehogs;
   336     hasGirders:= Template.hasGirders;
   338     hasGirders:= Template.hasGirders;
   337     playHeight:= Template.TemplateHeight;
   339     playHeight:= Template.TemplateHeight;
   338     playWidth:= Template.TemplateWidth;
   340     playWidth:= Template.TemplateWidth;
   339     leftX:= (LAND_WIDTH - playWidth) div 2;
   341     leftX:= (LAND_WIDTH - playWidth) div 2;
   340     rightX:= leftX + playWidth - 1;
   342     rightX:= Pred(leftX + playWidth);
   341     topY:= LAND_HEIGHT - playHeight;
   343     topY:= LAND_HEIGHT - playHeight;
   342     
   344     
   343     {$HINTS OFF}
   345     {$HINTS OFF}
   344     SetPoints(Template, pa, @fps);
   346     SetPoints(Template, pa, @fps);
   345     {$HINTS ON}
   347     {$HINTS ON}