Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TURBLE.ZIP/PAINT.PAS

Pascal/Delphi Source File | 1986-03-31 | 5.9 KB | 139 lines

   {Paints the inside of any regular figure and some irregular
   figures.  There are two known limitations to this procedure.

   First, if you try to paint a jagged horizontal edge (a range of
   mountains or sharks teeth), only one tooth will be painted.  You
   can sometimes get around this by drawing and painting each tooth
   separately.

   Second, if you draw a circle and try to paint the inside,
   everything is fine.  But if you try to paint the outside, only one
   side will be painted.  This is no great problem since you can paint
   the outside, then draw the circle and paint the inside blank.

   I'll try to fix the first limitation soon.  The second doesn't seem
   so important, but maybe I'll do it too. }

Procedure Paint(X, Y, Border, Color : Integer);
Const
  Up    = -1;                 {Constants to use as boolean flags...       }
  Down  =  1;                 {...and to decrement or increment.          }
  Left  = -1;
  Right =  1;

Var
  UpDown, RightLeft,
  TUY, TDY, UpX, DownX,
  LastUpRX, LastUpLX,
  LastDownRX, LastDownLX : Integer;
  Inside, UpDone, DownDone : Boolean;

Procedure OneLine(OX, OY : integer);   {Finds the left and right edges...}
var                                    {and draws a line between them.   }
  TLX, TRX : Integer;                  {Also stores edges for future use.}

begin
  TRX := OX;                          {Find the right edge.              }
  Repeat TRX := TRX + Right until (ColorDot(TRX,OY) = Border) or (TRX = XMax);
  If UpDown = Up then LastUpRX := TRX else LastDownRX := TRX;
  TLX := OX;                          {Find the left edge.               }
  Repeat TLX := TLX + Left until (ColorDot(TLX,OY) = Border) or (TLX = 0);
  If UpDown = Up then LastUpLX := TLX else LastDownLX := TLX;
  Draw(TLX + 1,OY,TRX,OY,Color);           {Draw the line.               }
end;

  {Notice above that the line starts one pixel to the left of the edge.
   That's how Turbo's LINE procedure works and the sooner you figure it out,
   the sooner you can avoid all the trouble I have writing this procedure.}

  {This procedure tries to find a point inside the figure.  If it finds one,
   it paints the line.}

Procedure CheckIn(TY : Integer);

  {This procedure checks one side, either right or left depending on the
   current status of RightLeft. }

Procedure CheckSide;
var
  TestX, LastRX, LastLX : Integer;

begin
  If UpDown = Up then
    begin                                  {Get the last edges...          }
      LastRX := LastUpRX;                  {...for appropriate direction.  }
      LastLX := LastUpLX
    end
  else
    begin
      LastRX := LastDownRX;
      LastLX := LastDownLX;
    end;
  TestX := X;
  Repeat                                   {Increment or decrement until...}
    TestX := TestX + RightLeft;            {...you reach an empty space.   }
  Until (ColorDot(TestX, TY) <> Border) or (TestX = 0) or (TestX = XMax);
  If (TestX < LastRX) and (TestX > LastLX) {See if it's inside.            }
    then Inside := True else Inside := False;
  If Inside then
    begin                                  {If it is, then change X...     }
      X := TestX;                          {...and draw a line.            }
      OneLine(X,TY);
    end;
end;

begin
  CheckSide;                               {Check the last successful side.}
  If not Inside then                       {Then the other if necessary.   }
    begin
      RightLeft := -RightLeft;
      CheckSide;
    end;
  If not Inside then                       {If still not in, you're done.  }
    If UpDown = Up then UpDone := True else DownDone := True;
end;

Procedure DrawUp;
begin
  UpDown := Up;                            {Set direction.                 }
  X := UpX;                                {Get saved X for Up.            }
  TUY := TUY + Up;                         {Decrement the height.          }
                   {Draw until you hit the border, then check the upline.  }
  If ColorDot(X, TUY) = Border then CheckIn(TUY) else OneLine(X,TUY);
  If TUY = 0 then UpDone := True;          {Quit at edge of screen.        }
  UpX := X;                                {Save X for Up.                 }
end;

Procedure DrawDown;
begin
  UpDown := Down;                          {Set direction.                 }
  X := DownX;                              {Get saved X for Down.          }
  TDY := TDY + Down;                       {Increment the height.          }
                   {Draw until you hit the border, then check the downline.}
  If ColorDot(X, TDY) = Border then CheckIn(TDY) else OneLine(X,TDY);
  If TDY = 199 then DownDone := True;      {Quit at edge of screen.        }
  DownX := X;                              {Save X for Up.                 }
end;

begin
  RightLeft := Right;                      {Set starting values.           }
  UpDown := Down;
  DownX := X;  UpX := X;
  If ColorDot(X,Y) <> Border then          {Initial point can't be border. }
    begin
      Y := Round(Y * Scrunch);             {Adjust for aspect.             }
      OneLine(X, Y);                       {Draw first line.               }
      TUY := Y; UpDone := False;           {Set variables.                 }
      TDY := Y; DownDone := False;
      Repeat
        If not UpDone then DrawUp;         {Alternately draw Up...         }
        If not DownDone then DrawDown;     {...and Down...                 }
      Until UpDone and DownDone;           {...until done.                 }
    end;
end;