hedgewars/uLandOutline.pas
changeset 6580 6155187bf599
parent 6491 736479f3d348
child 6990 40e5af28d026
equal deleted inserted replaced
6579:fc52f7c22c9b 6580:6155187bf599
    29 
    29 
    30 procedure Push(_xl, _xr, _y, _dir: LongInt);
    30 procedure Push(_xl, _xr, _y, _dir: LongInt);
    31 begin
    31 begin
    32     TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
    32     TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
    33     _y:= _y + _dir;
    33     _y:= _y + _dir;
    34     if (_y < 0) or (_y >= LAND_HEIGHT) then exit;
    34     if (_y < 0) or (_y >= LAND_HEIGHT) then
       
    35         exit;
    35     with Stack.points[Stack.Count] do
    36     with Stack.points[Stack.Count] do
    36             begin
    37         begin
    37             xl:= _xl;
    38         xl:= _xl;
    38             xr:= _xr;
    39         xr:= _xr;
    39             y:= _y;
    40         y:= _y;
    40             dir:= _dir
    41         dir:= _dir
    41             end;
    42         end;
    42     inc(Stack.Count)
    43     inc(Stack.Count)
    43 end;
    44 end;
    44 
    45 
    45 procedure Pop(var _xl, _xr, _y, _dir: LongInt);
    46 procedure Pop(var _xl, _xr, _y, _dir: LongInt);
    46 begin
    47 begin
    64     Push(xl, xr, y,  1);
    65     Push(xl, xr, y,  1);
    65     dir:= 0;
    66     dir:= 0;
    66     while Stack.Count > 0 do
    67     while Stack.Count > 0 do
    67         begin
    68         begin
    68         Pop(xl, xr, y, dir);
    69         Pop(xl, xr, y, dir);
    69         while (xl > 0) and (Land[y, xl] <> 0) do dec(xl);
    70         while (xl > 0) and (Land[y, xl] <> 0) do
    70         while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do inc(xr);
    71             dec(xl);
       
    72         while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do
       
    73             inc(xr);
    71         while (xl < xr) do
    74         while (xl < xr) do
    72             begin
    75             begin
    73             while (xl <= xr) and (Land[y, xl] = 0) do inc(xl);
    76             while (xl <= xr) and (Land[y, xl] = 0) do
       
    77                 inc(xl);
    74             x:= xl;
    78             x:= xl;
    75             while (xl <= xr) and (Land[y, xl] <> 0) do
    79             while (xl <= xr) and (Land[y, xl] <> 0) do
    76                 begin
    80                 begin
    77                 Land[y, xl]:= 0;
    81                 Land[y, xl]:= 0;
    78                 inc(xl)
    82                 inc(xl)
   110 
   114 
   111     d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y);
   115     d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y);
   112     d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y);
   116     d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y);
   113     d2:= Distance(Vx, Vy);
   117     d2:= Distance(Vx, Vy);
   114 
   118 
   115     if d1 < d then d:= d1;
   119     if d1 < d then
   116     if d2 < d then d:= d2;
   120         d:= d1;
       
   121     if d2 < d then
       
   122         d:= d2;
   117 
   123 
   118     d:= d * _1div3;
   124     d:= d * _1div3;
   119 
   125 
   120     if d2.QWordValue = 0 then
   126     if d2.QWordValue = 0 then
   121         begin
   127         begin
   146 {$HINTS OFF}
   152 {$HINTS OFF}
   147 Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
   153 Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
   148 {$HINTS ON}
   154 {$HINTS ON}
   149 repeat
   155 repeat
   150     inc(pi);
   156     inc(pi);
   151     if pi > EndI then pi:= StartI;
   157     if pi > EndI then
       
   158         pi:= StartI;
   152     inc(i);
   159     inc(i);
   153     if i > EndI then i:= StartI;
   160     if i > EndI then
       
   161         i:= StartI;
   154     inc(ni);
   162     inc(ni);
   155     if ni > EndI then ni:= StartI;
   163     if ni > EndI then
       
   164         ni:= StartI;
   156     PVx:= NVx;
   165     PVx:= NVx;
   157     PVy:= NVy;
   166     PVy:= NVy;
   158     Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
   167     Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
   159 
   168 
   160     x1:= opa.ar[pi].x;
   169     x1:= opa.ar[pi].x;
   165     cy1:= int2hwFloat(y1) - PVy;
   174     cy1:= int2hwFloat(y1) - PVy;
   166     cx2:= int2hwFloat(x2) + NVx;
   175     cx2:= int2hwFloat(x2) + NVx;
   167     cy2:= int2hwFloat(y2) + NVy;
   176     cy2:= int2hwFloat(y2) + NVy;
   168     t:= _0;
   177     t:= _0;
   169     while t.Round = 0 do
   178     while t.Round = 0 do
   170           begin
   179         begin
   171           tsq:= t * t;
   180         tsq:= t * t;
   172           tcb:= tsq * t;
   181         tcb:= tsq * t;
   173           r1:= (_1 - t*3 + tsq*3 - tcb);
   182         r1:= (_1 - t*3 + tsq*3 - tcb);
   174           r2:= (     t*3 - tsq*6 + tcb*3);
   183         r2:= (     t*3 - tsq*6 + tcb*3);
   175           r3:= (           tsq*3 - tcb*3);
   184         r3:= (           tsq*3 - tcb*3);
   176           X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2);
   185         X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2);
   177           Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2);
   186         Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2);
   178           t:= t + Delta;
   187         t:= t + Delta;
   179           pa.ar[pa.Count].x:= X;
   188         pa.ar[pa.Count].x:= X;
   180           pa.ar[pa.Count].y:= Y;
   189         pa.ar[pa.Count].y:= Y;
   181           inc(pa.Count);
   190         inc(pa.Count);
   182           TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)
   191         TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)
   183           end;
   192         end;
   184 until i = StartI;
   193 until i = StartI;
   185 pa.ar[pa.Count].x:= opa.ar[StartI].X;
   194 pa.ar[pa.Count].x:= opa.ar[StartI].X;
   186 pa.ar[pa.Count].y:= opa.ar[StartI].Y;
   195 pa.ar[pa.Count].y:= opa.ar[StartI].Y;
   187 inc(pa.Count)
   196 inc(pa.Count)
   188 end;
   197 end;
   195 pa.Count:= 0;
   204 pa.Count:= 0;
   196 i:= 0;
   205 i:= 0;
   197 StartLoop:= 0;
   206 StartLoop:= 0;
   198 while i < LongInt(opa.Count) do
   207 while i < LongInt(opa.Count) do
   199     if (opa.ar[i + 1].X = NTPX) then
   208     if (opa.ar[i + 1].X = NTPX) then
   200        begin
   209         begin
   201        AddLoopPoints(pa, opa, StartLoop, i, Delta);
   210         AddLoopPoints(pa, opa, StartLoop, i, Delta);
   202        inc(i, 2);
   211         inc(i, 2);
   203        StartLoop:= i;
   212         StartLoop:= i;
   204        pa.ar[pa.Count].X:= NTPX;
   213         pa.ar[pa.Count].X:= NTPX;
   205        pa.ar[pa.Count].Y:= 0;
   214         pa.ar[pa.Count].Y:= 0;
   206        inc(pa.Count);
   215         inc(pa.Count);
   207        end else inc(i)
   216         end else inc(i)
   208 end;
   217 end;
   209 
   218 
   210 
   219 
   211 function CheckIntersect(V1, V2, V3, V4: TPoint): boolean;
   220 function CheckIntersect(V1, V2, V3, V4: TPoint): boolean;
   212 var c1, c2, dm: LongInt;
   221 var c1, c2, dm: LongInt;
   213 begin
   222 begin
   214     dm:= (V4.y - V3.y) * (V2.x - V1.x) - (V4.x - V3.x) * (V2.y - V1.y);
   223     dm:= (V4.y - V3.y) * (V2.x - V1.x) - (V4.x - V3.x) * (V2.y - V1.y);
   215     c1:= (V4.x - V3.x) * (V1.y - V3.y) - (V4.y - V3.y) * (V1.x - V3.x);
   224     c1:= (V4.x - V3.x) * (V1.y - V3.y) - (V4.y - V3.y) * (V1.x - V3.x);
   216     if dm = 0 then exit(false);
   225     if dm = 0 then
       
   226             exit(false);
   217 
   227 
   218     c2:= (V2.x - V3.x) * (V1.y - V3.y) - (V2.y - V3.y) * (V1.x - V3.x);
   228     c2:= (V2.x - V3.x) * (V1.y - V3.y) - (V2.y - V3.y) * (V1.x - V3.x);
   219     if dm > 0 then
   229     if dm > 0 then
   220         begin
   230         begin
   221         if (c1 < 0) or (c1 > dm) then exit(false);
   231         if (c1 < 0) or (c1 > dm) then
   222         if (c2 < 0) or (c2 > dm) then exit(false)
   232             exit(false);
       
   233         if (c2 < 0) or (c2 > dm) then
       
   234             exit(false)
   223         end 
   235         end 
   224     else
   236     else
   225         begin
   237         begin
   226         if (c1 > 0) or (c1 < dm) then exit(false);
   238         if (c1 > 0) or (c1 < dm) then
   227         if (c2 > 0) or (c2 < dm) then exit(false)
   239             exit(false);
       
   240         if (c2 > 0) or (c2 < dm) then
       
   241             exit(false)
   228         end;
   242         end;
   229 
   243 
   230     //AddFileLog('1  (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')');
   244     //AddFileLog('1  (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')');
   231     //AddFileLog('2  (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')');
   245     //AddFileLog('2  (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')');
   232     CheckIntersect:= true
   246     CheckIntersect:= true
   234 
   248 
   235 
   249 
   236 function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean;
   250 function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean;
   237 var i: Longword;
   251 var i: Longword;
   238 begin
   252 begin
   239     if (ind <= 0) or (ind >= Pred(pa.Count)) then exit(false);
   253     if (ind <= 0) or (ind >= Pred(pa.Count)) then
       
   254                 exit(false);
   240     for i:= 1 to pa.Count - 3 do
   255     for i:= 1 to pa.Count - 3 do
   241         if (i <= ind - 1) or (i >= ind + 2) then
   256         if (i <= ind - 1) or (i >= ind + 2) then
   242         begin
   257         begin
   243         if (i <> ind - 1) and
   258         if (i <> ind - 1) and
   244             CheckIntersect(pa.ar[ind], pa.ar[ind - 1], pa.ar[i], pa.ar[i - 1]) then exit(true);
   259             CheckIntersect(pa.ar[ind], pa.ar[ind - 1], pa.ar[i], pa.ar[i - 1]) then
       
   260                 exit(true);
   245         if (i <> ind + 2) and
   261         if (i <> ind + 2) and
   246             CheckIntersect(pa.ar[ind], pa.ar[ind + 1], pa.ar[i], pa.ar[i - 1]) then exit(true);
   262             CheckIntersect(pa.ar[ind], pa.ar[ind + 1], pa.ar[i], pa.ar[i - 1]) then
       
   263                 exit(true);
   247         end;
   264         end;
   248     CheckSelfIntersect:= false
   265     CheckSelfIntersect:= false
   249 end;
   266 end;
   250 
   267 
   251 procedure RandomizePoints(var pa: TPixAr);
   268 procedure RandomizePoints(var pa: TPixAr);