dos_compilers/Borland Turbo Pascal v55/FIGURES.PAS

{ Turbo Figures }
{ Copyright (c) 1989 by Borland Interational, Inc. }

unit Figures;
{ From P-42 of the Object-Oriented Programming Guide.
  Virtual methods & polymorphic objects.
}

interface

uses Graph, Crt;

type
  Location = object
    X,Y : Integer;
    procedure Init(InitX, InitY : Integer);
    function GetX : Integer;
    function GetY : Integer;
  end;

  PointPtr = ^Point;

  Point    = object (Location)
    Visible : Boolean;
    constructor Init(InitX, InitY : Integer);
    destructor Done; virtual;
    procedure Show; virtual;
    procedure Hide; virtual;
    function IsVisible : Boolean;
    procedure MoveTo(NewX, NewY : Integer);
    procedure Drag(DragBy : Integer); virtual;
  end;

  CirclePtr = ^Circle;

  Circle   = object (Point)
    Radius : Integer;
    constructor Init(InitX, InitY : Integer;
                     InitRadius : Integer);
    procedure Show; virtual;
    procedure Hide; virtual;
    procedure Expand(ExpandBy : Integer); virtual;
    procedure Contract(ContractBy : Integer); virtual;
  end;

implementation

{--------------------------------------------------------}
{ Location's method implementations:                     }
{--------------------------------------------------------}

procedure Location.Init(InitX, InitY : Integer);

begin
  X := InitX;
  Y := InitY;
end;

function Location.GetX : Integer;
begin
  GetX := X;
end;

function Location.GetY : Integer;
begin
  GetY := Y;
end;


{--------------------------------------------------------}
{ Points's method implementations:                       }
{--------------------------------------------------------}

constructor Point.Init(InitX, InitY : Integer);
begin
  Location.Init(InitX, InitY);
  Visible := False;
end;

destructor Point.Done;
begin
  Hide;
end;

procedure Point.Show;
begin
  Visible := True;
  PutPixel(X, Y, GetColor);
end;

procedure Point.Hide;
begin
  Visible := False;
  PutPixel(X, Y, GetBkColor);
end;

function Point.IsVisible : Boolean;
begin
  IsVisible := Visible;
end;

procedure Point.MoveTo(NewX, NewY : Integer);
begin
  Hide;
  X := NewX;
  Y := NewY;
  Show;
end;

function GetDelta(var DeltaX : Integer;
                  var DeltaY : Integer) : Boolean;
var
  KeyChar : Char;
  Quit : Boolean;
begin
  DeltaX := 0; DeltaY := 0;  { 0 means no change in position;  }
  GetDelta := True;          { True means we return a delta    }
  repeat
    KeyChar := ReadKey;      { First, read the keystroke }
    Quit := True;            { Assume it's a useable key }
    case Ord(KeyChar) of
       0: begin          { 0 means an extended, 2-byte code }
            KeyChar := ReadKey;  { Read second byte of code }
            case Ord(KeyChar) of
             72: DeltaY := -1;   { Up arrow; decrement Y }
             80: DeltaY := 1;    { Down arrow; increment Y }
             75: DeltaX := -1;   { Left arrow; decrement X }
             77: DeltaX := 1;    { Right arrow; increment X }
             else Quit := False; { Ignore any other code }
            end; { case }
          end;
      13: GetDelta := False; { CR pressed means no delta  }
      else Quit := False;    { Ignore any other keystroke }
    end;  { case }
  until Quit;
end;

procedure Point.Drag(DragBy : Integer);
var
  DeltaX, DeltaY : Integer;
  FigureX, FigureY : Integer;
begin
  Show;               { Display figure to be dragged }
  FigureX := GetX;    { Get the initial position of figure }
  FigureY := GetY;

  { This is the drag loop : }
  while GetDelta(DeltaX, DeltaY) do
  begin               { Apply delta to figure X,Y: }
    FigureX := FigureX + (DeltaX * DragBy);
    FigureY := FigureY + (DeltaY * DragBy);
    MoveTo(FigureX, FigureY); { And tell the figure to move }
  end;
end;

{--------------------------------------------------------}
{ Circle's method implementations:                       }
{--------------------------------------------------------}

constructor Circle.Init(InitX, InitY : Integer;
                        InitRadius : Integer);
begin
  Point.Init(InitX, InitY);
  Radius := InitRadius;
end;

procedure Circle.Show;
begin
  Visible := True;
  Graph.Circle(X, Y, Radius);
end;

procedure Circle.Hide;
var
  TempColor : Word;
begin
  TempColor := Graph.GetColor;
  Graph.SetColor(GetBkColor);
  Visible := False;
  Graph.Circle(X, Y, Radius);
  Graph.SetColor(TempColor);
end;

procedure Circle.Expand(ExpandBy : Integer);
begin
  Hide;
  Radius := Radius + ExpandBy;
  if Radius <0 then Radius := 0;
  Show;
end;

procedure Circle.Contract(ContractBy : Integer);
begin
  Expand(-ContractBy);
end;

{ No initialization section }

end.