old/PAS/Lagrange/l4.PAS

USES Graph,CRT;

CONST
  Size = 40;

TYPE
   Point3D = Record
     X,Y : Real;
   End;

VAR  CtrlPt: Array [-1..80] Of Point3D;

{--------------------------------------}
PROCEDURE Spline_Calc (Ap, Bp, Cp, Dp: Point3D; T, D: Real; Var X, Y: Real);
VAR T2, T3: Real;
BEGIN
   T2 := T * T;                                       { Square of t }
   T3 := T2 * T;                                      { Cube of t }
   X := ((Ap.X*T3) + (Bp.X*T2) + (Cp.X*T) + Dp.X)/D;  { Calc x value }
   Y := ((Ap.Y*T3) + (Bp.Y*T2) + (Cp.Y*T) + Dp.Y)/D;  { Calc y value }
END;

PROCEDURE BSpline_ComputeCoeffs (N: Integer; Var Ap, Bp, Cp, Dp: Point3D);
BEGIN
   Ap.X := -CtrlPt[N-1].X + 3*CtrlPt[N].X - 3*CtrlPt[N+1].X + CtrlPt[N+2].X;
   Bp.X := 3*CtrlPt[N-1].X - 6*CtrlPt[N].X + 3*CtrlPt[N+1].X;
   Cp.X := -3*CtrlPt[N-1].X + 3*CtrlPt[N+1].X;
   Dp.X := CtrlPt[N-1].X + 4*CtrlPt[N].X + CtrlPt[N+1].X;
   Ap.Y := -CtrlPt[N-1].Y + 3*CtrlPt[N].Y - 3*CtrlPt[N+1].Y + CtrlPt[N+2].Y;
   Bp.Y := 3*CtrlPt[N-1].Y - 6*CtrlPt[N].Y + 3*CtrlPt[N+1].Y;
   Cp.Y := -3*CtrlPt[N-1].Y + 3*CtrlPt[N+1].Y;
   Dp.Y := CtrlPt[N-1].Y + 4*CtrlPt[N].Y + CtrlPt[N+1].Y;
END;
{--------------------------------------}

PROCEDURE BSpline (N, Resolution, Colour: Integer);
VAR
  I, J: Integer;
  X, Y, Lx, Ly: Real;
  Ap, Bp, Cp, Dp: Point3D;
BEGIN
   SetColor(Colour);
   CtrlPt[-1] := CtrlPt[1];
   CtrlPt[0] := CtrlPt[1];
   CtrlPt[N+1] := CtrlPt[N];
   CtrlPt[N+2] := CtrlPt[N];
   For I := 0 To N Do Begin
     BSpline_ComputeCoeffs(I, Ap, Bp, Cp, Dp);
     Spline_Calc(Ap, Bp, Cp, Dp, 0, 8, Lx, Ly);
     For J := 1 To Resolution Do Begin
       Spline_Calc(Ap, Bp, Cp, Dp, J/Resolution, 8, X, Y);
       Line(Round(Lx), Round(Ly), Round(X), Round(Y));
       Lx := X; Ly := Y;
     End;
   End;
END;
{--------------------------------------}
VAR
  I, J, Res, NumPts: Integer;
BEGIN
   I := Detect;
   InitGraph(I, J, '');
   NumPts := 5;
   Res := 80;
   CtrlPt[1].X := 100;         CtrlPt[1].Y := 100;
   CtrlPt[NumPts].X := 600; CtrlPt[NumPts].Y := 200;
While not Keypressed do begin
   Randomize;
   ClearDevice;
   for j := 2 to NumPts-1 do With CtrlPt[j] do
    begin
     X := Random(640);
     Y := Random(480);
    end;
   BSpline(NumPts, Res, LightGreen);
   for j := 1 to NumPts do Circle(round(Ctrlpt[j].x),round(Ctrlpt[j].y),4);
   ReadKey;
   End;
   CloseGraph;
END.