-- $Date: 2004/01/11 02:34:49 $
-- $Revision: 1.13 $
-- $Author: jcrocholl $

with Messages; use Messages;

package body Cubics is

   -- Create a cubic bezier curve.
   function Create
     (To        : in Vector-- End point of the curve.
      Control_A : in Vector-- First control point of curve.
      Control_B : in Vector-- Second control point of curve.
     return Line is          -- The newly created curve.
   begin
      return new Cubic_Record'(To => To,
        Control_A => Control_A,
        Control_B => Control_B,
        Length => 0.0);
   end Create;

   -- Calculate the arc length of this curve. Results are cached for
   -- reuse. So make sure the starting point always remains the same
   -- between calls.
   function Length
     (Start : in Vector;           -- Starting point of the curve.
      This  : access Cubic_Record-- Get this curve's arc length.
     return Real is                -- The length of the arc.
   begin
      if This.Length = 0.0 then
         This.Length := abs(This.To - Start);
      end if;
      return This.Length;
   end Length;

   -- Scale a curve by a given factor.
   procedure Scale
     (This   : access Cubic_Record-- Scale this curve.
      Factor : in Real) is          -- Scaling factor.
   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;

   -- Translate a curve by a given offset.
   procedure Translate
     (This   : access Cubic_Record-- Translate this curve.
      Offset : in Vector) is        -- Translating offset.
   begin
      This.To := This.To + Offset;
      This.Control_A := This.Control_A + Offset;
      This.Control_B := This.Control_B + Offset;
   end Translate;

   -- Get one point from the cubic bezier curve.
   function Way_Point
     (Start : in Vector;           -- Starting point of the curve.
      This  : access Cubic_Record-- Definition of the curve.
      Part  : in Real)             -- Parametrization variable from 0 to 1.
     return Vector                 -- The point on the curve.
   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;

   -- Create a cubic bezier curve that goes through 4 given points.
   -- According to the PostScript Reference Manual.
   function Make_Cubic_With_Coefficients
     (D, C, B, A : in Vector-- Coefficients for ascending degrees of t.
     return Line              -- The newly created cubic bezier curve.
   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;

   -- Create a cubic bezier curve that goes through 4 given points.
   function Make_Cubic_Through_Points
     (F0 : in Vector-- Starting point.
      F1 : in Vector-- Go through this inner point at t=1/3.
      F2 : in Vector-- Go through this inner point at t=2/3.
      F3 : in Vector-- End point.
     return Line      -- The newly created cubic bezier curve.
   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);
      -- Create an interpolating polynomial with Newton's divided differences.
      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);
      -- Coefficients for ascending degrees of t.
      D : Vector := F0;
      C : Vector := F01 - (X1) * F012 + (X1 * X2) * F0123;
      B : Vector := F012 - X1 * F0123 - X2 * F0123;
      A : Vector := F0123;
   begin
      -- Debug(To_String(X0) & ' ' & To_String(F0) & ' ' & To_String(F01)
      -- & ' ' & To_String(F012) & ' ' & To_String(F0123));
      -- Debug(To_String(X1) & ' ' & To_String(F1) & ' ' & To_String(F12)
      -- & ' ' & To_String(F123));
      -- Debug(To_String(X2) & ' ' & To_String(F2) & ' ' & To_String(F23));
      -- Debug(To_String(X3) & ' ' & To_String(F3));
      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);
      -- return Create(P2, P0 + (P1 - P0) / 2.0, P2 - (P1 - P2) / 2.0);
   end Make_Cubic_From_Slopes;

   -- Create a cubic bezier curve by joining two adjacent lines.
   -- Output value Error is the maximum distance between the original
   -- lines and the newly created curve.
   procedure Make_Cubic
     (Start  : in Vector-- Starting vector.
      A, B   : in Line;   -- Two adjacent lines.
      Result : out Line;  -- The new cubic bezier curve.
      Error  : out Real)  -- The maximum error.
   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_From_Slopes(Start, A.To, B.To);
      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;

   -- Format a cubic bezier curve for postscript output.
   function Postscript
     (This : access Cubic_Record-- Format this curve.
     return String is             -- The resulting postscript code.
   begin
      return
        Postscript(This.Control_A) & " " &
        Postscript(This.Control_B) & " " &
        Postscript(This.To) & " curveto";
   end Postscript;

end Cubics;