home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / filling / fill.inc next >
Encoding:
Text File  |  1987-10-08  |  4.5 KB  |  174 lines
  1. PROCEDURE Fill_Region (X, Y:  Real);
  2.  
  3. {  Region-filling code developed from a description of the algorithm
  4. in Fundamentals of Interactive Computer Graphics, Foley & Van Dam
  5. 1982, p. 450-451.
  6.  
  7.    No provision has been made for differences between the FILL color
  8. and the BOUNDRY color; both are assumed to be the current set color.
  9. This is because the Graphix Toolbox is not set up to cope with multi-
  10. color high-resolution display images.  }
  11.  
  12. { By Fred Robinson
  13.      Monotreme Software     Copyright (c) 1987 Monotreme Software
  14.      29766 Everett
  15.      Southfield, MI  48076
  16.      USA  }
  17.  
  18. TYPE
  19.    { Stack for storing potential starting points }
  20.    Pair_Ptr = ^Pair;
  21.    Pair = RECORD
  22.               X, Y:  Integer;
  23.               Next:  Pair_Ptr
  24.            END;
  25.  
  26. VAR
  27.    Top_Pair, This_Pair:  Pair_Ptr;
  28.    Start_X, Start_Y, X1Loc, X2Loc:  Integer;
  29.  
  30.    (****************************************************************)
  31.  
  32.    PROCEDURE Fill_Line (X, Y:  Integer);
  33.  
  34.    {   This procedure fills in the pixel line Y, starting at point X,
  35.    first moving to the right to the rightmost unfilled pixel, then
  36.    from (X, Y) to the left to the leftmost unfilled pixel.  On both
  37.    passes, the lines above & below are checked for candidate starting
  38.    points.  That is, if (X, Y) is not already filled in.  }
  39.  
  40.    VAR
  41.       X1, X2, Y_Above, Y_Below:  Integer;
  42.  
  43.       (*************************************************************)
  44.  
  45.       PROCEDURE Check_Point (X, Y:  Integer);
  46.  
  47.       {  This procedure checks (X, Y) and, if it is a point to start
  48.       filling at, adds it to the stack.  }
  49.  
  50.       VAR
  51.          This_Pair:  Pair_Ptr;
  52.  
  53.       BEGIN
  54.       IF (X>=X1Loc) AND (X<=X2Loc) AND (Y>=Y1RefGlb) AND
  55.          (Y<=Y2RefGlb) THEN
  56.          {  Making sure that (X, Y) is within legal limits  }
  57.          IF NOT PD (X, Y) THEN
  58.             IF (X=X2Loc) OR PD (X+1, Y) THEN
  59.                {  Believe it or not, this double-IF construct
  60.                   is faster than ANDing the two condiitons  }
  61.                BEGIN
  62.                New (This_Pair);
  63.                This_Pair^.X := X;
  64.                This_Pair^.Y := Y;
  65.                This_Pair^.Next := Top_Pair;
  66.                Top_Pair := This_Pair
  67.                END (* THEN, THEN, THEN *)
  68.       END (* Check_Point *);
  69.  
  70.       (*************************************************************)
  71.  
  72.    BEGIN (* Fill_Line *)
  73.    IF NOT PD (X, Y) THEN
  74.       BEGIN
  75.  
  76.       {  Fill in to the right of (X, Y)  }
  77.  
  78.       X1 := X;
  79.       Y_Above := Y - 1;
  80.       Y_Below := Y + 1;
  81.  
  82.       WHILE (X1<=X2Loc) AND NOT PD (X1, Y) DO
  83.          BEGIN
  84.          Check_Point (X1, Y_Below);
  85.          Check_Point (X1, Y_Above);
  86.          DP (X1, Y);
  87.          X1 := X1 + 1
  88.          END (* WHILE *);
  89.  
  90.       {  Check above and below beyond the right end of the line just
  91.          filled in  }
  92.  
  93.       X2 := X1 - 1;
  94.  
  95.       WHILE (X2<=X2Loc) AND NOT PD (X2, Y_Below) DO
  96.          BEGIN
  97.          Check_Point (X2, Y_Below);
  98.          X2 := X2 + 1
  99.          END (* WHILE *);
  100.  
  101.       X2 := X1 - 1;
  102.  
  103.       WHILE (X2<=X2Loc) AND NOT PD (X2, Y_Above) DO
  104.          BEGIN
  105.          Check_Point (X2, Y_Above);
  106.          X2 := X2 + 1
  107.          END (* WHILE *);
  108.  
  109.       {  Fill in to the left of (X, Y)  }
  110.  
  111.       X1 := X - 1;
  112.  
  113.       WHILE (X1>=X1Loc) AND NOT PD (X1, Y) DO
  114.          BEGIN
  115.          Check_Point (X1, Y_Below);
  116.          Check_Point (X1, Y_Above);
  117.          DP (X1, Y);
  118.          X1 := X1 - 1
  119.          END (* WHILE *)
  120.       END (* THEN *)
  121.    END (* Fill_Line *);
  122.  
  123.    (****************************************************************)
  124.  
  125. BEGIN (* Fill_Region *)
  126.  
  127. {  Get pixel coordinates of (X, Y)  }
  128.  
  129. IF DirectModeGlb THEN
  130.    BEGIN
  131.    Start_X := Round (X);
  132.    Start_Y := Round (Y)
  133.    END (* THEN *)
  134.  
  135. ELSE
  136.    BEGIN
  137.    Start_X := WindowX (X);
  138.    Start_Y := WindowY (Y)
  139.    END (* ELSE *);
  140.  
  141. {  Push the given starting point onto the stack  }
  142.  
  143. New (Top_Pair);
  144. Top_Pair^.Next := NIL;
  145. Top_Pair^.X := Start_X;
  146. Top_Pair^.Y := Start_Y;
  147.  
  148. {  Set the proper X-bounds  }
  149.  
  150. IF HatchGlb THEN
  151.    BEGIN
  152.    X1Loc := X1RefGlb;
  153.    X2Loc := X2Refglb;
  154.    END (* THEN *)
  155.  
  156. ELSE
  157.    BEGIN
  158.    X1Loc := X1RefGlb SHL 3;
  159.    X2Loc := X2RefGlb SHL 3 + 7
  160.    END (* ELSE *);
  161.  
  162. {  Fill in until there are no more starting points on the stack  }
  163.  
  164. WHILE Top_Pair<>NIL DO
  165.    BEGIN
  166.    This_Pair := Top_Pair;
  167.    Top_Pair := Top_Pair^.Next;
  168.    Start_X := This_Pair^.X;
  169.    Start_Y := This_Pair^.Y;
  170.    Dispose (This_Pair);
  171.    Fill_Line (Start_X, Start_Y);
  172.    END (* WHILE *)
  173. END (* Fill_Region *);
  174.