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

Pascal/Delphi Source File | 1986-03-31 | 8.1 KB | 256 lines

Program TurbleGraphics;

Const
  SCRUNCHUP = 0.83;      {User defined variable -- from ASPECT.PAS}
  HIXMAX = 640; HIYMAX = 480;
  CIRCUMFERENCE = 360; HALFCIRCUMFERENCE = 180;

Var
  ColorOfPen, ColorOfBack, PaletteColors : Integer;
  PenDown, ColorIsOn, ResolutionHigh : Boolean;

  {The maximum X and Y values (automatically adjusted).  Use like constants.}

Function XMax : Integer;
begin
  If ResolutionHigh then XMax := HiXMax else XMax := HiXMax div 2;
end;

Function YMax : Integer;
begin
  If ResolutionHigh then YMax := HiYMax else YMax := HiYMax div 2;
end;

  {For the next procedure, use the Turbo color constants or these constants.}

Const
  NONE = 99;             {A color constant high enough not to be a color}
  ON = 1; OFF = 0;       {Use ON only in black and white or high resolution}

    {Sets the color of the pen.}

Procedure PenColor(Color : Integer);
begin
  If Color > 15 then
    begin
      PenDown := False;                 {Too high number turns off pen}
      ColorOfPen := Off;
    end
  else
    begin
      ColorOfPen := Color;
      PenDown := True;
    end;
end;

    {Sets background in color mode}

Procedure BackColor(Color : Integer);
begin
  If not ResolutionHigh then
    begin
      ColorOfBack := Color mod 15;
      GraphBackGround(ColorOfBack);
    end
  else ColorOfBack := 0;
end;

   {Sets Palette in color mode.}

Procedure Palettor(Number : Integer);
begin
  If ColorIsOn then
    begin
      PaletteColors := Number mod 4;
      Palette(PaletteColors);
    end
  else if not ResolutionHigh then
    begin
      PaletteColors := Number mod 2;
      Palette(PaletteColors);
    end
  else
    begin
      PaletteColors := Number mod 16;
      HiResColor(PaletteColors);
    end;
end;

   {You can use these variables in programs, especially CenterX, and CenterY}

Var
  CenterX, CenterY, StartX, StartY, TurtleAngle : Integer;

   {Sets turtle initial parameters. Use to reset startup defaults.}

Procedure InitTurtle;
begin                           {Places turtle in center...       }
  TurtleAngle := 0;             {...with angle of 0.              }
  CenterX := XMax div 2;        {Sets global variables.           }
  CenterY := YMax div 2;        {Center variables stay the same.  }
  StartX := CenterX;            {Start variable change often.     }
  StartY := CenterY;
  If not ResolutionHigh then
    begin                       {With medium resolution set the...}
      BackColor(0);             {...background to 0...            }
      Palettor(0);              {...and palette to 0.             }
    end else Palettor(15);      {Set to brightest color for HiRes.}
  PenColor(On);                 {Turn pen on.                     }
end;

   {Set graphics or text modes using the following constants.}

Const
  MR  =  4;              {Medium Resolution }
  CMR =  5;   MRC  = 5;  {Medium Resolution Color --two versions}
  HR  =  6;              {High Resolution   }

   {Use this variable if you need to adjust for aspect.}

Var
  Scrunch : Real;

   {Sets the mode and the appropriate variables for each.}

Procedure Mode(Setting : Integer);
begin
  If Setting > 6 then Setting := Setting mod 6;
  Case Setting of
    0 : TextMode(BW40);        {Use Turbo's predefined constants for these}
    1 : TextMode(C40);
    2 : TextMode(BW80);
    3 : TextMode(C80);
    4 : begin
          GraphMode;                  {Sets mode...               }
          Scrunch := Scrunchup;       {...screen aspect...        }
          ColorIsOn := False;         {...color flag...           }
          ResolutionHigh := False;    {...and hi resolution flag. }
          InitTurtle;                 {Initiate automatically.    }
        end;
    5 : begin
          GraphColorMode;             {Mode...                    }
          Scrunch := Scrunchup;       {...screen aspect...        }
          ColorIsOn := True;          {...color flag...           }
          ResolutionHigh := False;    {...and resolution flag.    }
          InitTurtle;                 {Initiate automatically.    }
        end;
    6 : begin
          HiRes;                      {Mode...                    }
          Scrunch := Scrunchup / 2;   {...screen aspect to half...}
          ColorIsOn := False;         {...color flag...           }
          ResolutionHigh := True;     {...and resolution flag.    }
          InitTurtle;                 {Initiate automatically.    }
        end;
  end;
end;

    {Transforms Turbo's Plot to work on adjusted grid with predefined color.}

Procedure Dot(X, Y : Integer);
begin
     Y := Round(Y * Scrunch);
     Plot(X,Y,ColorOfPen);
end;

  {Transforms Turbo's Draw to work on adjusted grid with predefined color.}

Procedure Line(X1, Y1, X2, Y2 : Integer);
begin
    Y1 := Round(Y1 * Scrunch); Y2 := Round(Y2 * Scrunch);
    Draw(X1,Y1,X2,Y2,ColorOfPen);
end;

  {Sets TurtleAngle relative to starting angle.  Adjusts angles above 360.}

Procedure Turn(Angle : Integer);
begin
  TurtleAngle := TurtleAngle + Angle;
  If (TurtleAngle > Circumference) or (TurtleAngle < -Circumference)
    then TurtleAngle := TurtleAngle mod Circumference;
end;

  {Sets absolute TurtleAngle.  Adjusts angles above 360.}

Procedure TurnTo(Angle : Integer);
begin
  TurtleAngle := Angle;
  If (TurtleAngle > Circumference) or (TurtleAngle < -Circumference)
    then TurtleAngle := TurtleAngle mod Circumference;
end;

  {The heart of Turtle graphics.  Draws a line from the current Turtle
   position to a point determined by calculating the arc of the
   TurtleAngle.  Then makes the new point destination the new turtle
   position.}

Procedure Go(Distance : Integer);
var
  dX, dY : Integer;
  WorkAngle : Real;

begin
  WorkAngle := (TurtleAngle - 90) * pi / HalfCircumference;
  dX := Round(Distance * cos(WorkAngle));
  dY := Round(Distance * sin(WorkAngle));
  If PenDown then Line(StartX,StartY,StartX + dX,StartY + dY);
  StartX := StartX + dX;
  StartY := StartY + dY;
end;

   {Moves to an absolute position. Resets the Turtle position.}

Procedure MoveTo(X, Y : Integer);
begin
  If PenDown then Line(StartX,StartY,X,Y);
  StartX := X;StartY := Y;
end;

  {Returns the color of a dot at any given position.  This routine is
   used in the Paint procedure.  It can also be used in animation for
   testing to see if a moving figure has reached a certain point.}

Function ColorDot(X, Y : Integer) : Byte;
Type
  RegPack = Record
              ax,bx,cx,dx,bp,di,si,ds,es,flags: Integer;
            end;
Const
  Vid = $10;                             {The video routine interrupt. }

Var
  RecPack:          RegPack;             {Assign record.               }
  ah,al:   Byte;

begin
  ah := $0D;                             {Initialize registers with... }
  With RecPack do                        {...appropriate values.       }
    begin
      ax := ah Shl 8 + al;
      cx := x;
      dx := y;
    end;
  Intr(Vid,RecPack);                     {Call interrupt. It returns...}
  ColorDot := Lo(RecPack.ax);            {...the color of the dot.     }
end;

   {Draws any regular figure.  This is the most popular and versatile
    procedure in Turtle graphics.  Many of the more complex procedures
    in TURBLE2.PAS are variations of it.  Since the angle must be
    rounded, small inaccuracies creep in, especially with many-sided
    figures.  Your figures may be slightly out of proportion.}

Procedure Poly(Number, Side : Integer);

Var
  I, Angle : Integer;

begin
  Angle := Round(360/Number);     {The turning angle is 360 divided by...}
  For I := 1 to Number do         {...the number of sides.               }
    begin
      Go(Side);                   {Draw a side...                        }
      Turn(Angle);                {...turn the angle.                    }
    end;
end;