-- CurveExtras.mesa
-- Michael Plass  November 30, 1982 9:16 am
-- Maureen Stone  

DIRECTORY
  Cubic,
  Curve,
  JaMFnsDefs,
  LSCurve,
  LSFit,
  LSPiece,
  Real,
  Seq,
  Vector;
  
  
CurveExtras: PROGRAM
  IMPORTS Cubic, Curve, JaMFnsDefs, LSCurve, LSFit, Real =
BEGIN

lsHandle: LSFit.Handle _ NIL;
lscurve: LSCurve.Handle _ NIL;

LinksFromPatches: PROC [x, y: LSFit.PatchSequence] =
	BEGIN
	Curve.ResetLinks[Curve.defaultHandle];
	FOR i:NAT IN [0..x.length) DO
		Curve.AddLink[Curve.defaultHandle, Cubic.CoeffsToBezier[[
			c0: [x[i].c0, y[i].c0],
			c1: [x[i].c1, y[i].c1],
			c2: [x[i].c2, y[i].c2],
			c3: [x[i].c3, y[i].c3]]]];
		ENDLOOP;
	END;

GetPoint: PROC RETURNS [v: Vector.Vec] = {
	v.y _ JaMFnsDefs.GetReal[];
	v.x _ JaMFnsDefs.GetReal[];
	};

BezierGet: PROC = { OPEN Vector;
	x,y: INTEGER _ 0;
	b: Cubic.Bezier;
	addSample: PROC [v: Vector.Vec] = {Curve.AddSample[Curve.defaultHandle, v.x,v.y]};
	b.b3 _ GetPoint[];
	b.b2 _ GetPoint[];
	b.b1 _ GetPoint[];
	b.b0 _ GetPoint[];
	Curve.ResetSamples[Curve.defaultHandle];
	Cubic.BezierPolygon[b,0.5,addSample];
	};

InitialSpline: PROCEDURE =
    BEGIN ENABLE Real.RealException =>
	    TRUSTED {JaMFnsDefs.JaMExec["(Real Exception) .print"]; CONTINUE};
    nknots: INTEGER _ JaMFnsDefs.PopInteger[];
    lsHandle _ LSFit.Create[Curve.CurrentSamples[Curve.defaultHandle]];
    lsHandle.closedCurve _ FALSE;
    LSFit.InitialKnots[lsHandle,nknots];
    LSFit.InitialTValues[lsHandle];
    LSFit.FitXAndY[lsHandle];
    LinksFromPatches[lsHandle.xPatches, lsHandle.yPatches];
    END;

InitialClosedSpline: PROCEDURE =
    BEGIN ENABLE Real.RealException =>
	    TRUSTED {JaMFnsDefs.JaMExec["(Real Exception) .print"]; CONTINUE};
    nknots: INTEGER _ JaMFnsDefs.PopInteger[];
    lsHandle _ LSFit.Create[Curve.CurrentSamples[Curve.defaultHandle]];
    lsHandle.closedCurve _ TRUE;
    LSFit.InitialKnots[lsHandle,nknots+1];
    LSFit.InitialTValues[lsHandle];
    LSFit.FitXAndY[lsHandle];
    LinksFromPatches[lsHandle.xPatches, lsHandle.yPatches];
    END;

ImproveSpline: PROCEDURE =
    BEGIN
    LSFit.ImproveParametricSpline[lsHandle];
    LinksFromPatches[lsHandle.xPatches, lsHandle.yPatches];
    END;

Lsamples: PROC =
    BEGIN
    lscurve _ LSCurve.Create[Curve.CurrentSamples[Curve.defaultHandle]];
    END;

Lresults: PROC =
    BEGIN
    x,y: LSCurve.PatchSequence;
    [x:x, y:y] _ LSCurve.PatchesOf[lscurve];
    LinksFromPatches[x,y];
    END;

Lsmoothbasis: PROC =
    BEGIN
    LSCurve.SmoothBasis[lscurve,JaMFnsDefs.PopInteger[]];
    END;

Lbsplinebasis: PROC =
    BEGIN
    LSCurve.BSplineBasis[lscurve,JaMFnsDefs.PopInteger[]];
    END;

Lcubicbasis: PROC =
    BEGIN
    LSCurve.CubicBasis[lscurve];
    END;

Lcubicpiecebasis: PROC =
    BEGIN
    LSCurve.CubicPieceBasis[lscurve];
    END;

Lparabolabasis: PROC =
    BEGIN
    LSCurve.ParabolaBasis[lscurve];
    END;

Lcirclebasis: PROC =
    BEGIN
    LSCurve.CircleBasis[lscurve];
    END;

Lellipsebasis: PROC =
    BEGIN
    LSCurve.EllipseBasis[lscurve];
    END;

Lpointslope: PROC =
    BEGIN
    bezier: Cubic.Bezier;
    bezier.b3 _ GetPoint[];
    bezier.b2 _ GetPoint[];
    bezier.b1 _ GetPoint[];
    bezier.b0 _ GetPoint[];
    LSCurve.PointSlopeBasis[lscurve,bezier];
    END;

Larclen: PROC =
    BEGIN
    LSCurve.ArcLengthInitialTValues[lscurve];
    END;

Lunit: PROC =
    BEGIN ENABLE ABORTED => GOTO Quit;
    LSCurve.UnitInitialTValues[lscurve];
    EXITS Quit => {}
    END;

Langle: PROC =
    BEGIN
    LSCurve.AngleInitialTValues[lscurve];
    END;

Lsolve: PROC =
    BEGIN
    LSCurve.SolveCurve[lscurve];
    END;

Ladjust: PROC =
    BEGIN
    JaMFnsDefs.PushReal[LSCurve.AdjustTValues[lscurve]];
    END;

Laccel: PROC =
    BEGIN
    r,d: REAL;
    [r,d] _ LSCurve.AccelTValues[lscurve];
    JaMFnsDefs.PushReal[d];
    JaMFnsDefs.PushReal[r];
    END;

Lfree: PROC =
    BEGIN
    n: INTEGER _ JaMFnsDefs.PopInteger[];
    IF lscurve=NIL OR lscurve.free=NIL OR n<0 OR n>=lscurve.free.length THEN {
        JaMFnsDefs.JaMExec["(bad basis function index) .print"];
        RETURN};
    lscurve.free[n] _ TRUE;
    END;

Lfix: PROC =
    BEGIN
    n: INTEGER _ JaMFnsDefs.PopInteger[];
    IF lscurve=NIL OR lscurve.free=NIL OR n<0 OR n>=lscurve.free.length THEN {
        JaMFnsDefs.JaMExec["(bad basis function index) .print"];
        RETURN};
    lscurve.free[n] _ FALSE;
    END;

LShowT: PROC = {
    IF lscurve=NIL THEN RETURN;
    FOR i:NAT IN [lscurve.l..lscurve.n] DO
        Curve.DrawLine[lscurve.z[i], LSCurve.XYat[lscurve,lscurve.t[i]]];
        ENDLOOP;
    };

LSort: PROC = {
    IF lscurve=NIL THEN RETURN;
    LSFit.Sort[lscurve.t];
    };    

JaMFnsDefs.Register[".bezierget"L,BezierGet];

-- LSFit calls
JaMFnsDefs.Register[".initspline"L,InitialSpline];
JaMFnsDefs.Register[".initclosedspline"L,InitialClosedSpline];
JaMFnsDefs.Register[".improvespline"L,ImproveSpline];

-- LSCurve calls
JaMFnsDefs.Register[".lsamples"L,Lsamples];
JaMFnsDefs.Register[".lresults"L,Lresults];
JaMFnsDefs.Register[".lpointslope"L,Lpointslope];
JaMFnsDefs.Register[".lsmoothbasis"L,Lsmoothbasis];
JaMFnsDefs.Register[".lbsplinebasis"L,Lbsplinebasis];
JaMFnsDefs.Register[".lcubicbasis"L,Lcubicbasis];
JaMFnsDefs.Register[".lcubicpiecebasis"L,Lcubicpiecebasis];
JaMFnsDefs.Register[".lparabolabasis"L,Lparabolabasis];
JaMFnsDefs.Register[".lcirclebasis"L,Lcirclebasis];
JaMFnsDefs.Register[".lellipsebasis"L,Lellipsebasis];
JaMFnsDefs.Register[".larclen"L,Larclen];
JaMFnsDefs.Register[".lunit"L,Lunit];
JaMFnsDefs.Register[".langle"L,Langle];
JaMFnsDefs.Register[".lsolve"L,Lsolve];
JaMFnsDefs.Register[".ladjust"L,Ladjust];
JaMFnsDefs.Register[".laccel"L,Laccel];
JaMFnsDefs.Register[".lfree"L,Lfree];
JaMFnsDefs.Register[".lfix"L,Lfix];
JaMFnsDefs.Register[".lshowt"L,LShowT];
JaMFnsDefs.Register[".lsort"L,LSort];
END.