Hosted by
 |
with Messages; use Messages;
package body Cubics is
function Create
(To : in Vector;
Control_A : in Vector;
Control_B : in Vector)
return Line is
begin
return new Cubic_Record'(To => To,
Control_A => Control_A,
Control_B => Control_B,
Length => 0.0);
end Create;
function Length
(Start : in Vector;
This : access Cubic_Record)
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 Cubic_Record;
Factor : in Real) is
begin
This.To := This.To * Factor;
This.Control_A := This.Control_A * Factor;
This.Control_B := This.Control_B * Factor;
This.Length := This.Length * Factor;
end Scale;
procedure Translate
(This : access Cubic_Record;
Offset : in Vector) is
begin
This.To := This.To + Offset;
This.Control_A := This.Control_A + Offset;
This.Control_B := This.Control_B + Offset;
end Translate;
function Way_Point
(Start : in Vector;
This : access Cubic_Record;
Part : in Real)
return Vector
is
Part_1 : Real := 1.0 - Part;
begin
return Start * Cube(Part_1) +
This.Control_A * 3.0 * Square(Part_1) * Part +
This.Control_B * 3.0 * Part_1 * Square(Part) +
This.To * Cube(Part);
end Way_Point;
function Make_Cubic_With_Coefficients
(D, C, B, A : in Vector)
return Line
is
Control_A : Vector := D + C / 3.0;
Control_B : Vector := Control_A + (C + B) / 3.0;
To : Vector := D + C + B + A;
begin
return Create(To => To,
Control_A => Control_A,
Control_B => Control_B);
end Make_Cubic_With_Coefficients;
function Make_Cubic_Through_Points
(F0 : in Vector;
F1 : in Vector;
F2 : in Vector;
F3 : in Vector)
return Line
is
X0 : Vector := (0.0, 0.0);
X1 : Vector := (1.0 / 3.0, 1.0 / 3.0);
X2 : Vector := (2.0 / 3.0, 2.0 / 3.0);
X3 : Vector := (1.0, 1.0);
F01 : Vector := 3.0 * (F1 - F0);
F12 : Vector := 3.0 * (F2 - F1);
F23 : Vector := 3.0 * (F3 - F2);
F012 : Vector := 1.5 * (F12 - F01);
F123 : Vector := 1.5 * (F23 - F12);
F0123 : Vector := 1.0 * (F123 - F012);
D : Vector := F0;
C : Vector := F01 - (X1) * F012 + (X1 * X2) * F0123;
B : Vector := F012 - X1 * F0123 - X2 * F0123;
A : Vector := F0123;
begin
return Make_Cubic_With_Coefficients(D, C, B, A);
end Make_Cubic_Through_Points;
function Make_Cubic_From_Slopes
(P0, P1, P2 : in Vector)
return Line is
begin
return Create(P2, P1, P1);
end Make_Cubic_From_Slopes;
procedure Make_Cubic
(Start : in Vector;
A, B : in Line;
Result : out Line;
Error : out Real)
is
Length_A : Real := Length(Start, A);
Length_B : Real := Length(A.To, B);
Length_Both : Real := Length_A + Length_B;
Part_A : Real := Length_A / Length_Both;
function Way_Point
(Part : in Real)
return Vector is
begin
if Part < Part_A
then return Way_Point(Start, A, Part * Length_Both / Length_A);
else return Way_Point(A.To, B, (Part - Part_A) * Length_Both / Length_B);
end if;
end Way_Point;
Interpolate_A : Vector := Way_Point(1.0 / 3.0);
Interpolate_B : Vector := Way_Point(2.0 / 3.0);
Part : Real;
begin
Result := Make_Cubic_Through_Points(Start, Interpolate_A, Interpolate_B, B.To);
Error := 0.0;
for Index in 1 .. 24 loop
Part := Real(Index * 2 - 1) / 48.0;
Error := Real'Max(Error, abs(Way_Point(Part) - Way_Point(Start, Result, Part)));
end loop;
end Make_Cubic;
function Postscript
(This : access Cubic_Record)
return String is
begin
return
Postscript(This.Control_A) & " " &
Postscript(This.Control_B) & " " &
Postscript(This.To) & " curveto";
end Postscript;
end Cubics;
|