hedgewars/uLandOutline.pas
changeset 10189 875607ce793d
parent 8850 ae8a957c69fd
child 10197 c57798251b55
equal deleted inserted replaced
10188:e8f2dbabd01b 10189:875607ce793d
     7 type TPixAr = record
     7 type TPixAr = record
     8               Count: Longword;
     8               Count: Longword;
     9               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
     9               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
    10               end;
    10               end;
    11 
    11 
    12 procedure DrawEdge(var pa: TPixAr; Color: Longword);
    12 procedure DrawEdge(var pa: TPixAr; value: Word);
    13 procedure FillLand(x, y: LongInt);
    13 procedure FillLand(x, y: LongInt; border, value: Word);
    14 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
    14 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
    15 procedure RandomizePoints(var pa: TPixAr);
    15 procedure RandomizePoints(var pa: TPixAr);
    16 
    16 
    17 implementation
    17 implementation
    18 
    18 
    54         _y:= y;
    54         _y:= y;
    55         _dir:= dir
    55         _dir:= dir
    56         end
    56         end
    57 end;
    57 end;
    58 
    58 
    59 procedure FillLand(x, y: LongInt);
    59 procedure FillLand(x, y: LongInt; border, value: Word);
    60 var xl, xr, dir: LongInt;
    60 var xl, xr, dir: LongInt;
    61 begin
    61 begin
    62     Stack.Count:= 0;
    62     Stack.Count:= 0;
    63     xl:= x - 1;
    63     xl:= x - 1;
    64     xr:= x;
    64     xr:= x;
    66     Push(xl, xr, y,  1);
    66     Push(xl, xr, y,  1);
    67     dir:= 0;
    67     dir:= 0;
    68     while Stack.Count > 0 do
    68     while Stack.Count > 0 do
    69         begin
    69         begin
    70         Pop(xl, xr, y, dir);
    70         Pop(xl, xr, y, dir);
    71         while (xl > 0) and (Land[y, xl] <> 0) do
    71         while (xl > 0) and (Land[y, xl] <> border) and (Land[y, xl] <> value) do
    72             dec(xl);
    72             dec(xl);
    73         while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do
    73         while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> border) and (Land[y, xr] <> value) do
    74             inc(xr);
    74             inc(xr);
    75         while (xl < xr) do
    75         while (xl < xr) do
    76             begin
    76             begin
    77             while (xl <= xr) and (Land[y, xl] = 0) do
    77             while (xl <= xr) and ((Land[y, xl] = border) or (Land[y, xl] = value)) do
    78                 inc(xl);
    78                 inc(xl);
    79             x:= xl;
    79             x:= xl;
    80             while (xl <= xr) and (Land[y, xl] <> 0) do
    80             while (xl <= xr) and (Land[y, xl] <> border) and (Land[y, xl] <> value) do
    81                 begin
    81                 begin
    82                 Land[y, xl]:= 0;
    82                 Land[y, xl]:= value;
    83                 inc(xl)
    83                 inc(xl)
    84                 end;
    84                 end;
    85             if x < xl then
    85             if x < xl then
    86                 begin
    86                 begin
    87                 Push(x, Pred(xl), y, dir);
    87                 Push(x, Pred(xl), y, dir);
    89                 end;
    89                 end;
    90             end;
    90             end;
    91         end;
    91         end;
    92 end;
    92 end;
    93 
    93 
    94 procedure DrawEdge(var pa: TPixAr; Color: Longword);
    94 procedure DrawEdge(var pa: TPixAr; value: Word);
    95 var i: LongInt;
    95 var i: LongInt;
    96 begin
    96 begin
    97     i:= 0;
    97     i:= 0;
    98     with pa do
    98     with pa do
    99         while i < LongInt(Count) - 1 do
    99         while i < LongInt(Count) - 1 do
   100             if (ar[i + 1].X = NTPX) then
   100             if (ar[i + 1].X = NTPX) then
   101                 inc(i, 2)
   101                 inc(i, 2)
   102             else
   102             else
   103                 begin
   103                 begin
   104                 DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color);
   104                 DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, value);
   105                 inc(i)
   105                 inc(i)
   106                 end
   106                 end
   107 end;
   107 end;
   108 
   108 
   109 
   109