1 unit uLandOutline;

     2 

     3 interface

     4 

     5 uses uConsts, SDLh, uFloat;

     6 

     7 type TPixAr = record

     8               Count: Longword;

     9               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;

    10               end;

    11 

    12 procedure DrawEdge(var pa: TPixAr; value: Word);

    13 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);

    14 

    15 implementation

    16 

    17 uses uLandGraphics, uDebug, uVariables, uLandTemplates;

    18 

    19 

    20 var Stack: record

    21            Count: Longword;

    22            points: array[0..8192] of record

    23                                      xl, xr, y, dir: LongInt;

    24                                      end

    25            end;

    26 

    27 

    28 procedure Push(_xl, _xr, _y, _dir: LongInt);

    29 begin

    30     if checkFails(Stack.Count <= 8192, 'FillLand: stack overflow', true) then exit;

    31     _y:= _y + _dir;

    32     if (_y < 0) or (_y >= LAND_HEIGHT) then

    33         exit;

    34     with Stack.points[Stack.Count] do

    35         begin

    36         xl:= _xl;

    37         xr:= _xr;

    38         y:= _y;

    39         dir:= _dir

    40         end;

    41     inc(Stack.Count)

    42 end;

    43 

    44 procedure Pop(var _xl, _xr, _y, _dir: LongInt);

    45 begin

    46     dec(Stack.Count);

    47     with Stack.points[Stack.Count] do

    48         begin

    49         _xl:= xl;

    50         _xr:= xr;

    51         _y:= y;

    52         _dir:= dir

    53         end

    54 end;

    55 

    56 procedure DrawEdge(var pa: TPixAr; value: Word);

    57 var i: LongInt;

    58 begin

    59     i:= 0;

    60     with pa do

    61         while i < LongInt(Count) - 1 do

    62             if (ar[i + 1].X = NTPX) then

    63                 inc(i, 2)

    64             else

    65                 begin

    66                 DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, value);

    67                 inc(i)

    68                 end

    69 end;

    70 

    71 

    72 procedure Vector(p1, p2, p3: TPoint; var Vx, Vy: hwFloat);

    73 var d1, d2, d: hwFloat;

    74 begin

    75     Vx:= int2hwFloat(p1.X - p3.X);

    76     Vy:= int2hwFloat(p1.Y - p3.Y);

    77 

    78     d2:= Distance(Vx, Vy);

    79 

    80     if d2.QWordValue = 0 then

    81         begin

    82         Vx:= _0;

    83         Vy:= _0

    84         end

    85     else

    86         begin

    87         d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y);

    88         d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y);

    89 

    90         if d1 < d then

    91             d:= d1;

    92         if d2 < d then

    93             d:= d2;

    94 

    95         d2:= d * _1div3 / d2;

    96 

    97         Vx:= Vx * d2;

    98         Vy:= Vy * d2

    99         end

   100 end;

   101 

   102 procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat);

   103 var i, pi, ni: LongInt;

   104     NVx, NVy, PVx, PVy: hwFloat;

   105     x1, x2, y1, y2: LongInt;

   106     tsq, tcb, t, r1, r2, r3, cx1, cx2, cy1, cy2: hwFloat;

   107     X, Y: LongInt;

   108 begin

   109     if pa.Count < cMaxEdgePoints - 2 then

   110         begin

   111         pi:= EndI;

   112         i:= StartI;

   113         ni:= Succ(StartI);

   114         {$HINTS OFF}

   115         Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);

   116         {$HINTS ON}

   117         repeat

   118             i:= ni;

   119             inc(pi);

   120             if pi > EndI then

   121                 pi:= StartI;

   122             inc(ni);

   123             if ni > EndI then

   124                 ni:= StartI;

   125             PVx:= NVx;

   126             PVy:= NVy;

   127             Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);

   128 

   129             x1:= opa.ar[pi].x;

   130             y1:= opa.ar[pi].y;

   131             x2:= opa.ar[i].x;

   132             y2:= opa.ar[i].y;

   133 

   134             cx1:= int2hwFloat(x1) - PVx;

   135             cy1:= int2hwFloat(y1) - PVy;

   136             cx2:= int2hwFloat(x2) + NVx;

   137             cy2:= int2hwFloat(y2) + NVy;

   138             t:= _0;

   139             while (t.Round = 0) and (pa.Count < cMaxEdgePoints-2) do

   140                 begin

   141                 tsq:= t * t;

   142                 tcb:= tsq * t;

   143                 r1:= (_1 - t*3 + tsq*3 - tcb);

   144                 r2:= (     t*3 - tsq*6 + tcb*3);

   145                 r3:= (           tsq*3 - tcb*3);

   146                 X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2);

   147                 Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2);

   148                 t:= t + Delta;

   149                 pa.ar[pa.Count].x:= X;

   150                 pa.ar[pa.Count].y:= Y;

   151                 inc(pa.Count);

   152                 //TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)

   153                 end;

   154         until i = StartI;

   155         end;

   156 

   157     pa.ar[pa.Count].x:= opa.ar[StartI].X;

   158     pa.ar[pa.Count].y:= opa.ar[StartI].Y;

   159     inc(pa.Count)

   160 end;

   161 

   162 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);

   163 var i, StartLoop: LongInt;

   164     opa: TPixAr;

   165 begin

   166 opa:= pa;

   167 pa.Count:= 0;

   168 i:= 0;

   169 StartLoop:= 0;

   170 while (i < LongInt(opa.Count)) and (pa.Count < cMaxEdgePoints-1) do

   171     if (opa.ar[i + 1].X = NTPX) then

   172         begin

   173         AddLoopPoints(pa, opa, StartLoop, i, Delta);

   174         inc(i, 2);

   175         StartLoop:= i;

   176         pa.ar[pa.Count].X:= NTPX;

   177         pa.ar[pa.Count].Y:= 0;

   178         inc(pa.Count);

   179         end else inc(i)

   180 end;

   181 

   182 end.