Hosted by
|
package body Straights is
function Create
(To : in Vector)
return Line_Access is
begin
return new Straight'(To => To, Length => 0.0);
end Create;
function Length
(Start : in Vector;
This : access Straight)
return Real is
begin
if This.Length = 0.0 then
This.Length := abs(This.To - Start);
end if;
return This.Length;
end Length;
procedure Scale
(This : access Straight;
Factor : in Real) is
begin
This.To := This.To * Factor;
This.Length := This.Length * Factor;
end Scale;
procedure Translate
(This : access Straight;
Offset : in Vector) is
begin
This.To := This.To + Offset;
end Translate;
function Way_Point
(Start : in Vector;
This : access Straight;
Part : in Real)
return Vector is
begin
return Start + Part * (This.To - Start);
end Way_Point;
function To_SVG
(This : access Straight;
Tolerance : in Real)
return String is
begin
return "L " & To_String(This.To, Tolerance);
end To_SVG;
function To_Postscript
(This : access Straight;
Tolerance : in Real)
return String is
begin
return To_String(Mirror_Y(This.To), Tolerance) & " lineto";
end To_Postscript;
end Straights;
|