hedgewars/uLandGenTemplateBased.pas
changeset 10199 fdb689b57b1b
parent 10198 e9cbe111c0df
child 10200 edc2fe0ca03f
equal deleted inserted replaced
10198:e9cbe111c0df 10199:fdb689b57b1b
     4 uses uLandTemplates;
     4 uses uLandTemplates;
     5 
     5 
     6 procedure GenTemplated(var Template: TEdgeTemplate);
     6 procedure GenTemplated(var Template: TEdgeTemplate);
     7 
     7 
     8 implementation
     8 implementation
     9 uses uTypes, uVariables, uConsts, uFloat, uLandOutline, uLandUtils, uRandom;
     9 uses uVariables, uConsts, uFloat, uLandOutline, uLandUtils, uRandom, SDLh;
    10 
    10 
    11 
    11 
    12 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr; fps: PPointArray);
    12 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr; fps: PPointArray);
    13 var i: LongInt;
    13 var i: LongInt;
    14 begin
    14 begin
    17         pa.Count:= BasePointsCount;
    17         pa.Count:= BasePointsCount;
    18         for i:= 0 to pred(pa.Count) do
    18         for i:= 0 to pred(pa.Count) do
    19             begin
    19             begin
    20             pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));
    20             pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));
    21             if pa.ar[i].x <> NTPX then
    21             if pa.ar[i].x <> NTPX then
    22             pa.ar[i].x:= pa.ar[i].x + ((LAND_WIDTH - Template.TemplateWidth) div 2);
    22                 pa.ar[i].x:= pa.ar[i].x + ((LAND_WIDTH - Template.TemplateWidth) div 2);
    23             pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h)) + LAND_HEIGHT - LongInt(Template.TemplateHeight)
    23             pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h)) + LAND_HEIGHT - LongInt(Template.TemplateHeight)
    24             end;
    24             end;
    25 
    25 
    26         if canMirror then
    26         if canMirror then
    27             if getrandom(2) = 0 then
    27             if getrandom(2) = 0 then
    76         for i:= 0 to pred(FillPointsCount) do
    76         for i:= 0 to pred(FillPointsCount) do
    77             fps^[i].y:= LAND_HEIGHT - 1 - fps^[i].y;
    77             fps^[i].y:= LAND_HEIGHT - 1 - fps^[i].y;
    78         end;
    78         end;
    79     end
    79     end
    80 end;
    80 end;
    81     
    81 
       
    82 
       
    83 procedure Distort1(var Template: TEdgeTemplate; var pa: TPixAr);
       
    84 var i: Longword;
       
    85 begin
       
    86     for i:= 1 to Template.BezierizeCount do
       
    87         begin
       
    88         BezierizeEdge(pa, _0_5);
       
    89         RandomizePoints(pa);
       
    90         RandomizePoints(pa)
       
    91         end;
       
    92     for i:= 1 to Template.RandPassesCount do
       
    93         RandomizePoints(pa);
       
    94     BezierizeEdge(pa, _0_1);
       
    95 end;
       
    96 
       
    97 
       
    98 procedure FindLimits(si: LongInt; var pa: TPixAr);
       
    99 var p1, p2, mp, ap: TPoint;
       
   100     i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt;
       
   101 begin
       
   102     // [p1, p2] is segment we're trying to divide
       
   103     p1:= pa.ar[si];
       
   104     p2:= pa.ar[si + 1];
       
   105 
       
   106     // its middle point
       
   107     mp.x:= (p1.x + p2.x) div 2;
       
   108     mp.y:= (p1.y + p2.y) div 2;
       
   109     // another point on the perpendicular bisector
       
   110     ap.x:= mp.x + p2.y - p1.y;
       
   111     ap.y:= mp.y + p1.x - p2.x;
       
   112 
       
   113     for i:= 0 to pa.Count - 1 do
       
   114         if i <> si then
       
   115         begin
       
   116             // check if it intersects
       
   117             t1:= (mp.x - pa.ar[i].x) * (mp.y - ap.y) - (mp.x - ap.x) * (mp.y - pa.ar[i].y);
       
   118             t2:= (mp.x - pa.ar[i + 1].x) * (mp.y - ap.y) - (mp.x - ap.x) * (mp.y - pa.ar[i + 1].y);
       
   119 
       
   120             if (t1 > 0) <> (t2 > 0) then // yes it does, hard arith follows
       
   121             begin
       
   122                 a:= p2.y - p1.y;
       
   123                 b:= p1.x - p2.x;
       
   124                 p:= pa.ar[i + 1].x - pa.ar[i].x;
       
   125                 q:= pa.ar[i + 1].y - pa.ar[i].y;
       
   126                 aqpb:= a * q - p * b;
       
   127 
       
   128                 if (aqpb <> 0) then
       
   129                 begin
       
   130                     // (ix; iy) is intersection point
       
   131                     iy:= (((pa.ar[i].x - mp.x) * b + mp.y * a) * q - pa.ar[i].y * p * b);
       
   132                     if b <> 0 then
       
   133                         ix:= (iy - mp.y * aqpb) * a div b div aqpb + mp.x;
       
   134                     else
       
   135                         ix:= (iy - pa.ar[i].y * aqpb) * p div q div aqpb + pa.ar[i].x;
       
   136                     iy:= iy div aqpb;
       
   137 
       
   138                     writeln('>>>     Intersection     <<<');
       
   139                     writeln(p1.x, '; ', p1.y, ' - ', p2.x, '; ', p2.y);
       
   140                     writeln(pa.ar[i].x, '; ', pa.ar[i].y, ' - ', pa.ar[i + 1].x, '; ', pa.ar[i + 1].y);
       
   141                     writeln('== ', ix, '; ', iy);
       
   142                 end;
       
   143             end;
       
   144         end;
       
   145 end;
       
   146 
       
   147 procedure DivideEdges(var pa: TPixAr);
       
   148 var npa: TPixAr;
       
   149     i: LongInt;
       
   150 begin
       
   151     i:= 0;
       
   152     npa.Count:= 0;
       
   153     while i < pa.Count do
       
   154     begin
       
   155         if i = 0 then
       
   156         begin
       
   157             FindLimits(0, pa);
       
   158             npa.ar[npa.Count]:= pa.ar[i];
       
   159             pa.ar[i].y:= 300;
       
   160             npa.ar[npa.Count + 1]:= pa.ar[i];
       
   161             inc(npa.Count, 2)
       
   162         end else
       
   163         begin
       
   164             npa.ar[npa.Count]:= pa.ar[i];
       
   165             inc(npa.Count)
       
   166         end;
       
   167 
       
   168         inc(i)
       
   169     end;
       
   170 
       
   171     pa:= npa;
       
   172 end;
       
   173 
       
   174 procedure Distort2(var Template: TEdgeTemplate; var pa: TPixAr);
       
   175 //var i: Longword;
       
   176 begin
       
   177     DivideEdges(pa);
       
   178     {for i:= 1 to Template.BezierizeCount do
       
   179         begin
       
   180         BezierizeEdge(pa, _0_5);
       
   181         RandomizePoints(pa);
       
   182         RandomizePoints(pa)
       
   183         end;
       
   184     for i:= 1 to Template.RandPassesCount do
       
   185         RandomizePoints(pa);}
       
   186     BezierizeEdge(pa, _0_9);
       
   187 end;
       
   188 
       
   189 
    82 procedure GenTemplated(var Template: TEdgeTemplate);
   190 procedure GenTemplated(var Template: TEdgeTemplate);
    83 var pa: TPixAr;
   191 var pa: TPixAr;
    84     i: Longword;
   192     i: Longword;
    85     y, x: Longword;
   193     y, x: Longword;
    86     fps: TPointArray;
   194     fps: TPointArray;
    91         for x:= 0 to LAND_WIDTH - 1 do
   199         for x:= 0 to LAND_WIDTH - 1 do
    92             Land[y, x]:= lfBasic;
   200             Land[y, x]:= lfBasic;
    93     {$HINTS OFF}
   201     {$HINTS OFF}
    94     SetPoints(Template, pa, @fps);
   202     SetPoints(Template, pa, @fps);
    95     {$HINTS ON}
   203     {$HINTS ON}
    96     
   204 
    97     for i:= 1 to Template.BezierizeCount do
   205     Distort1(Template, pa);
    98         begin
       
    99         BezierizeEdge(pa, _0_5);
       
   100         RandomizePoints(pa);
       
   101         RandomizePoints(pa)
       
   102         end;
       
   103     for i:= 1 to Template.RandPassesCount do
       
   104         RandomizePoints(pa);
       
   105     BezierizeEdge(pa, _0_1);
       
   106 
       
   107 
   206 
   108     DrawEdge(pa, 0);
   207     DrawEdge(pa, 0);
   109 
   208 
   110     with Template do
   209     with Template do
   111         for i:= 0 to pred(FillPointsCount) do
   210         for i:= 0 to pred(FillPointsCount) do