-- CurveImpl.mesa
-- Last Edited by July 17, 1982 5:05 pm
-- Last Edited by Michael Plass  December 7, 1982 10:25 am
-- Last Edited by: Stone, November 21, 1983 11:33 am

DIRECTORY
  Cubic,
  Curve,
  Complex,
  ConvertUnsafe,
  IO,
  FileIO,
  TJaMGraphics USING [Painter],
  JaMFnsDefs,
  JaMBasic,
  JaMOps,
  Graphics,
  Real,
  Rope,
  Seq,
  Vector;

CurveImpl: PROGRAM
  IMPORTS Complex, ConvertUnsafe, TJaMGraphics, JaMFnsDefs, JaMOps, IO, FileIO, Graphics, Real, Rope, Vector
  EXPORTS Curve =
BEGIN OPEN JaMFnsDefs, Curve;

SampleHandle: TYPE = REF Sample;
SListHandle: TYPE = REF SList;
LinkHandle: TYPE = REF Link;
TrajHandle: TYPE = REF Traj;

Sample: TYPE = RECORD
        [next: SampleHandle _ NIL,
        prev: SampleHandle _ NIL,
        xy: Complex.Vec _ [0,0],
        isNode: BOOLEAN _ TRUE,
        isCusp: BOOLEAN _ FALSE,
        tangent: Complex.Vec _ [0,0],
        tanOut: Complex.Vec _ [0,0]
        ];

SList: TYPE = RECORD
        [header: SampleHandle,
        selectedSample: SampleHandle,
        first: SampleHandle _ NIL,
        last: SampleHandle _ NIL
        ];

Link: TYPE = RECORD
        [next: LinkHandle _ NIL,
        prev: LinkHandle _ NIL,
        cubic: Cubic.Bezier
        ];

Traj: TYPE = RECORD
        [next: TrajHandle _ NIL,
        prev: TrajHandle _ NIL,
        links: LinkHandle _ NIL,
        lastLink: LinkHandle _ NIL
        ];


stream: IO.Handle _ FileIO.Open["Curve.log", append];
OpenLogFile: PROC = {
    ls: LONG STRING _ [80];
    rope: Rope.ROPE;
    PopString[ls];
    rope _ ConvertUnsafe.ToRope[ls];
    IF stream # NIL THEN stream.Close[];
    stream _ NIL;
    IF rope.Length[] > 0 THEN stream _ FileIO.Open[rope, append];
    };

CloseLogFile: PROC = {
    IF stream # NIL THEN stream.Close[];
    stream _ NIL;
    typescript _ FALSE;
    };

Handle: PUBLIC TYPE = REF Rec;
Rec: PUBLIC TYPE = RECORD [
    traj: TrajHandle,
    slist: SListHandle,
    visible: BOOLEAN,
    otherContours: LIST OF TrajAndSlist
    ];

TrajAndSlist: TYPE = RECORD [
    traj: TrajHandle,
    slist: SListHandle
    ];

Create: PUBLIC PROC RETURNS [handle: Handle] = {
    handle _ NEW[Rec];
    handle.traj _ NEW[Traj];
    handle.slist _ NewSList[];
    handle.visible _ FALSE;
    handle.otherContours _ NIL;
    };

Visible: PUBLIC PROC [handle: Handle, visible: BOOLEAN _ TRUE]
    RETURNS [was: BOOLEAN] = {
    was _ handle.visible;
    handle.visible _ visible;
    };

TTY: PUBLIC PROC RETURNS[IO.Handle] = {RETURN[stream]}; 

ResetSa: PROC = {ResetSamples[defaultHandle]};

ResetSamples: PUBLIC PROC [handle: Handle] = {OPEN handle^;
    IF slist.header#NIL THEN slist.header.next _ slist.header.prev _ NIL;
    slist _ NewSList[]};

NewSList: PROC RETURNS [s: SListHandle] = {
    s _ NEW[SList];
    s.header _ NEW[Sample];
    s.selectedSample _ s.header.next _ s.header.prev _ s.header;
    s.first _ NIL;
    s.last _ NIL;
    };

InsertBefore: PROC[a: Complex.Vec, s: SampleHandle] = {
    new: SampleHandle _ NEW[Sample];
    new.xy _ a;
    new.prev _ s.prev;
    new.next _ s;
    s.prev _ new;
    new.prev.next _ new;
    };

StartSa: PROC = {y: REAL _ GetReal[]; x: REAL _ GetReal[]; StartSamples[defaultHandle, x,y]};

StartSamples: PUBLIC PROC[handle: Handle, x,y: REAL] = {ResetSamples[handle]; InsertBefore[[x,y], handle.slist.header]};

AddSa: PROC = {y: REAL _ GetReal[]; x: REAL _ GetReal[]; AddSample[defaultHandle, x,y]};
    
AddSample: PUBLIC PROC[handle: Handle, x,y: REAL] = {OPEN handle^;
    Paint: PROC[dc: Graphics.Context] = {
        IF Vector.Mag[Vector.Sub[[x,y],slist.header.prev.xy]]>sLen THEN { 
            IF slist.header.next#slist.header THEN
                {MoveTo[dc,slist.header.prev.xy]; DrawTo[dc,[x,y]]}; 
            InsertBefore[[x,y],slist.header];
            };
        };
    IF visible THEN TJaMGraphics.Painter[Paint]
    ELSE {
        IF Vector.Mag[Vector.Sub[[x,y],slist.header.prev.xy]]>sLen THEN {
            InsertBefore[[x,y],slist.header];
            };
        };
    };

CountSa: PROC = {OPEN defaultHandle^;
    s: SampleHandle;
    n: NAT _ 0;
    FOR s _ slist.header.next, s.next UNTIL s=slist.header DO
        n _ n+1;
        ENDLOOP;
    PushInteger[n];
    };

ResetLinks: PUBLIC PROC[handle: Handle] = {
    handle.traj.links _ NIL;
    handle.traj.lastLink _ NIL;
    };

AddLink: PUBLIC PROC[handle: Handle, b: Cubic.Bezier] = {OPEN handle^;
    Paint: PROC[dc: Graphics.Context] = {
        DrawCubic[dc,b];
        };
    new: LinkHandle _ NEW[Link];
    new.cubic _ b;
    IF traj.links=NIL THEN {
        traj.links _ new;
        traj.lastLink _ new;
        }
    ELSE {
        traj.lastLink.next _ new;
        new.prev _ traj.lastLink;
        traj.lastLink _ new;
        };
    IF visible THEN TJaMGraphics.Painter[Paint];
    };

ForAllLinks: PROC = {
    body: JaMBasic.Object _ JaMOps.Pop[JaMOps.defaultFrame.opstk];
    FOR l: LinkHandle _ defaultHandle.traj.links, l.next UNTIL l=NIL DO
        PushReal[l.cubic.b0.x];
        PushReal[l.cubic.b0.y];
        PushReal[l.cubic.b1.x];
        PushReal[l.cubic.b1.y];
        PushReal[l.cubic.b2.x];
        PushReal[l.cubic.b2.y];
        PushReal[l.cubic.b3.x];
        PushReal[l.cubic.b3.y];
        JaMOps.Execute[JaMOps.defaultFrame, body];
        ENDLOOP;
    };

ResetCon: PUBLIC PROC[] = {ResetContours[defaultHandle]};
ResetContours: PUBLIC PROC[handle: Handle] = {
    FOR p: LIST OF TrajAndSlist _ handle.otherContours, p.rest UNTIL p=NIL DO
        IF p.first.slist.header # NIL THEN p.first.slist.header.next _ p.first.slist.header.prev _ NIL;
        ENDLOOP;
    handle.otherContours _ NIL;
    ResetSamples[handle]
    };

CountCon: PUBLIC PROC[] = {PushInteger[CountContours[defaultHandle]]};
CountContours: PUBLIC PROC[handle: Handle] RETURNS [INT] = {
    i: INT _ 1;
    FOR p: LIST OF TrajAndSlist _ handle.otherContours, p.rest UNTIL p=NIL DO i_i+1 ENDLOOP;
    RETURN[i]
    };

AddCon: PUBLIC PROC[] = {AddContour[defaultHandle]};
AddContour: PUBLIC PROC[handle: Handle] = {
    IF handle.otherContours = NIL THEN handle.otherContours _ LIST[[handle.traj, handle.slist]]
    ELSE {
        p: LIST OF TrajAndSlist _ handle.otherContours;
        UNTIL p.rest = NIL DO p _ p.rest ENDLOOP;
        p.rest _ LIST[[handle.traj, handle.slist]];
        };
    handle.slist _ NewSList[];
    handle.traj _ NEW[Traj];
    };

NextCon: PUBLIC PROC[] = {NextContour[defaultHandle]};
NextContour: PUBLIC PROC[handle: Handle] = {
    IF handle.otherContours # NIL THEN {
        p: LIST OF TrajAndSlist _ handle.otherContours;
        ts: TrajAndSlist _ handle.otherContours.first;
        handle.otherContours.first _ [handle.traj, handle.slist];
        [handle.traj, handle.slist] _ ts;
        UNTIL p.rest = NIL DO p _ p.rest ENDLOOP;
        p.rest _ handle.otherContours; -- make it circular for a few microseconds
        p _ p.rest;
        handle.otherContours _ p.rest;
        p.rest _ NIL;
        }
    };

CurrentSamples: PUBLIC PROC[handle: Handle] RETURNS [z: Seq.ComplexSequence] = {OPEN handle^;
    s: SampleHandle;
    i: NAT;
    n: NAT _ 0;
    first: SampleHandle _ IF slist.first=NIL THEN slist.header.next ELSE slist.first;
    last: SampleHandle _ IF slist.last=NIL THEN slist.header ELSE slist.last.next;
    FOR s _ first, s.next UNTIL s=last DO
        n _ n+1;
        ENDLOOP;
    z _ NEW[Seq.ComplexSequenceRec[n]];
    i _ 0;
    FOR s_first, s.next UNTIL s=last DO
        z[i] _ s.xy;
        i_i+1;
        ENDLOOP;
    };

ResetDefaultNodes: PROC = {ResetNodes[defaultHandle]};
ResetNodes: PUBLIC PROC[handle: Handle] ={OPEN handle^;
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        s.isNode _ s.isCusp _ FALSE;
        s.tangent _ [0,0]
        ENDLOOP;
    };

AddNode: PUBLIC PROC[handle: Handle, index: NAT, tan: Complex.Vec _ [0,0]] = {OPEN handle^;
    i:NAT _ 0;
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        IF i=index THEN {s.isNode _ TRUE; s.tangent _ tan; RETURN};
        i_i+1;
        ENDLOOP;
    };

DeleteNode: PUBLIC PROC[handle: Handle, index: NAT] = {OPEN handle^;
    i:NAT _ 0;
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        IF i=index THEN {s.isNode _ s.isCusp _ FALSE; s.tangent _ [0,0]; RETURN};
        i_i+1;
        ENDLOOP;
    };

CurrentNodes: PUBLIC PROC [handle: Handle]
    RETURNS[nodes: Seq.NatSequence, tangents: Seq.ComplexSequence] = {OPEN handle^;
    i,n:NAT _ 0;
    first: SampleHandle _ IF slist.first=NIL THEN slist.header.next ELSE slist.first;
    last: SampleHandle _ IF slist.last=NIL THEN slist.header ELSE slist.last.next;
    FOR s: SampleHandle _ first, s.next UNTIL s=last DO
        IF s.isNode THEN n_n+1;
        ENDLOOP;
    nodes _ NEW[Seq.NatSequenceRec[n]];
    tangents _ NEW[Seq.ComplexSequenceRec[n]];
    i _ n _ 0;
    FOR s: SampleHandle _ first, s.next UNTIL s=last DO
        IF s.isNode THEN {nodes[n] _ i; tangents[n] _ s.tangent; n_n+1};
        i_i+1;
        ENDLOOP;
    };

ResetDefaultCusps: PROC = {ResetCusps[defaultHandle]};
ResetCusps: PUBLIC PROC [handle: Handle] = {OPEN handle^;
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        IF s.isCusp THEN {s.isCusp _ FALSE; s.tangent _ [0,0]; s.tanOut _ [0,0]};
        ENDLOOP;
    };

AddCusp: PUBLIC PROC[handle: Handle, index: NAT, tanIn,tanOut: Complex.Vec _ [0,0]] = {OPEN handle^;
    i:NAT _ 0;
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        IF i=index THEN {
            s.isCusp _ s.isNode _ TRUE;
            s.tangent _ tanIn;
            s.tanOut _ tanOut;
            RETURN};
        i_i+1;
        ENDLOOP;
    };

DeleteCusp: PUBLIC PROC[handle: Handle, index: NAT] = {OPEN handle^;
    i:NAT _ 0;
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        IF i=index THEN {
            s.isCusp _ s.isNode _ FALSE;
            s.tangent _ s.tanOut _ [0,0];
            RETURN};
        i_i+1;
        ENDLOOP;
    };

CurrentCusps: PUBLIC PROC[handle: Handle] RETURNS[cusps: Seq.NatSequence, tangents: Seq.ComplexSequence] = {OPEN handle^;
    i,n:NAT _ 0;
    first: SampleHandle _ IF slist.first=NIL THEN slist.header.next ELSE slist.first;
    last: SampleHandle _ IF slist.last=NIL THEN slist.header ELSE slist.last.next;
    FOR s: SampleHandle _ first, s.next UNTIL s=last DO
        IF s.isCusp THEN n_n+1;
        ENDLOOP;
    cusps _ NEW[Seq.NatSequenceRec[n]];
    tangents _ NEW[Seq.ComplexSequenceRec[2*n]];
    i _ n _ 0;
    FOR s: SampleHandle _ first, s.next UNTIL s=last DO
        IF s.isCusp THEN {
            cusps[n] _ i;
            tangents[2*n] _ s.tangent;
            tangents[2*n+1] _ s.tanOut;
            n_n+1};
        i_i+1;
        ENDLOOP;
    };

DrawSamples: PROC= {OPEN defaultHandle^;
    Paint: PROC[dc: Graphics.Context] = {
        s: SampleHandle _ slist.header.next;
        MoveTo[dc,s.xy];
        s _ s.next;
        WHILE s#slist.header DO
            DrawTo[dc,s.xy];
            s _ s.next;
            ENDLOOP;
        IF typescript THEN PrintLine["\n"];
        };
    TJaMGraphics.Painter[Paint];
    };

MarkSamples: PROC= {OPEN defaultHandle^;
    Paint: PROC[dc: Graphics.Context] = {
        oldFat: BOOLEAN _ Graphics.SetFat[dc,TRUE];
        FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
            MarkPoint[dc,s.xy];
        ENDLOOP;
        [] _ Graphics.SetFat[dc,oldFat];
        IF typescript THEN PrintLine["\n"];
        };
    TJaMGraphics.Painter[Paint];
    };

MarkLinks: PROC = {OPEN defaultHandle^;
    Paint: PROC[dc: Graphics.Context] = {
        Mark[dc,traj.links.cubic.b0];
        FOR l: LinkHandle _ traj.links, l.next UNTIL l=NIL DO
            Mark[dc,[l.cubic.b3.x,l.cubic.b3.y]];
            ENDLOOP;
        IF typescript THEN PrintLine["\n"];
        };
    IF traj.links # NIL THEN TJaMGraphics.Painter[Paint];
    };

MarkNodes: PROC = {OPEN defaultHandle^;
    Paint: PROC[dc: Graphics.Context] = {
        FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
            IF s.isNode THEN MarkNode[dc,s];
        ENDLOOP;
        IF typescript THEN PrintLine["\n"];
        };
    TJaMGraphics.Painter[Paint];
    };

MarkNode: PROC [dc: Graphics.Context, s: SampleHandle] = {
    d:REAL _ markSize/scale;
    IF s.isCusp THEN d _ 1.5*d;
    IF s.tangent = [0,0] THEN
        BEGIN OPEN s.xy;
        MoveTo[dc,[x+d,y+d]];
        DrawTo[dc,[x-d,y-d]];
        MoveTo[dc,[x-d,y+d]];
        DrawTo[dc,[x+d,y-d]];
        END
    ELSE
        BEGIN 
        t: Complex.Vec _ Complex.Mul[Vector.Unit[s.tangent],[0,2*d]];
        MoveTo[dc,Complex.Sub[s.xy,t]];
        DrawTo[dc,Complex.Add[s.xy,t]];
        IF s.isCusp THEN {
            t _ Complex.Mul[Vector.Unit[s.tanOut],[0,2*d]];
            MoveTo[dc,Complex.Sub[s.xy,t]];
            DrawTo[dc,Complex.Add[s.xy,t]];
            };
        END
    };

DrawLinks: PROC = {OPEN defaultHandle^;
    Paint: PROC[dc: Graphics.Context] = {
        MoveTo[dc,traj.links.cubic.b0];
        FOR l: LinkHandle _ traj.links, l.next UNTIL l=NIL DO
            CurveTo[dc,l.cubic.b1,l.cubic.b2,l.cubic.b3];
            ENDLOOP;
        IF fill THEN DrawArea[dc] ELSE DrawPath[dc,0];
        IF typescript THEN PrintLine["\n"];
        };
    IF traj.links # NIL THEN TJaMGraphics.Painter[Paint];
    };

markSize: REAL _ 2;
markPath: Graphics.Path _ Graphics.NewPath[4];
SetMarkSize: PROC = {markSize _ GetReal[]; };
Mark: PROC[dc: Graphics.Context, pt: Complex.Vec] = {
        pt _ XForm[pt];
        Graphics.MoveTo[markPath, 0, 0];
        Graphics.Rectangle[markPath, pt.x-markSize,pt.y-markSize,pt.x+markSize,pt.y+markSize];
        Graphics.DrawArea[dc, markPath];
        IF typescript THEN {PrintPoint[pt]; PrintString["mark  "]};
        };

MarkPoint: PROC[dc: Graphics.Context, pt: Complex.Vec] = {
        pt _ XForm[pt];
        Graphics.SetCP[dc,pt.x,pt.y];
        Graphics.DrawTo[dc,pt.x,pt.y];
         IF typescript THEN {PrintPoint[pt]; PrintString["mark  "]};
        };

SelectSa: PROC = {OPEN defaultHandle^;
    closest: SampleHandle;
    z: Complex.Vec;
    z.y _ GetReal[];
    z.x _ GetReal[];
    [closest,] _ FindSa[z];
    IF closest#NIL THEN slist.selectedSample _ closest;
    };

FindSa: PROC [z: Complex.Vec] RETURNS[found: SampleHandle, index: NAT] = {OPEN defaultHandle^;
    closest,d: REAL _ 10.0E+30;
    i: NAT _ 0;
    found _ NIL;
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        p: Complex.Vec _ XForm[s.xy];
        IF ABS[p.x-z.x]<closest AND ABS[p.y-z.y]<closest
        AND (d _ Vector.Mag[Vector.Sub[z,p]]) < closest THEN
            {closest _ d; found _ s; index _ i};
        i _ i+1;
        ENDLOOP;
    };

Subrange: PROC = {OPEN defaultHandle^;
    first,last: SampleHandle;
    p0,p1: Complex.Vec;
    i0,i1: NAT;
    p1.y _ GetReal[];
    p1.x _ GetReal[];
    [last,i1] _ FindSa[p1];
    p0.y _ GetReal[];
    p0.x _ GetReal[];
    [first,i0] _ FindSa[p0];
    IF i0<i1 THEN {slist.first _ first; slist.last _ last} ELSE {slist.first _ last; slist.last _ first};
    };

NoSubrange: PROC = {OPEN defaultHandle^; slist.first _ slist.last _ NIL};
       
DeleteSa: PROC = {OPEN defaultHandle^;
    IF slist.selectedSample # slist.header THEN {
        p,q:  SampleHandle;
        p _ slist.selectedSample.prev;
        q _ slist.selectedSample.next;
        p.next _ q;
        q.prev _ p;
        slist.selectedSample _ q
        };
    };

InsertSa: PROC = {OPEN defaultHandle^;
    z: Complex.Vec;
    samp: SampleHandle _ slist.selectedSample;
    z.y _ GetReal[];
    z.x _ GetReal[];
    InsertBefore[z, slist.selectedSample];
    };

InsertBetween: PROC = {OPEN defaultHandle^;
    z: Complex.Vec;
    insertBefore: BOOLEAN;
    samp: SampleHandle _ slist.selectedSample;
    z.y _ GetReal[];
    z.x _ GetReal[];
    insertBefore _
        (Vector.Mag[Vector.Sub[z, samp.prev.xy]] < Vector.Mag[Vector.Sub[z, samp.next.xy]]);
    IF insertBefore THEN InsertBefore[z, samp]
    ELSE InsertBefore[z, samp.next];
    };

TheSa: PROC = {OPEN defaultHandle^; PushReal[slist.selectedSample.xy.x]; PushReal[slist.selectedSample.xy.y]};

TheTan: PROC = {OPEN defaultHandle.slist.selectedSample;
    PushReal[tangent.x]; PushReal[tangent.y]; PushBoolean[isNode]};

HomeSa: PROC = {OPEN defaultHandle^; slist.selectedSample _ slist.header};

MakeFirstSa: PROC = {OPEN defaultHandle^;
    IF slist.selectedSample # NIL AND slist.selectedSample # slist.header AND slist.selectedSample # slist.header.next THEN {
        slist.header.next.prev _ slist.header.prev;
        slist.header.prev.next _  slist.header.next;
        slist.header.next _ slist.selectedSample;
        slist.header.prev _ slist.selectedSample.prev;
        slist.header.next.prev _ slist.header;
        slist.header.prev.next _ slist.header}
    };

NextSa: PROC = {OPEN defaultHandle^;
    slist.selectedSample _ slist.selectedSample.next;
    IF slist.selectedSample = slist.header THEN
        slist.selectedSample _ slist.selectedSample.next
    };

PrevSa: PROC = {OPEN defaultHandle^;
    slist.selectedSample _ slist.selectedSample.prev;
    IF slist.selectedSample = slist.header THEN
        slist.selectedSample _ slist.selectedSample.prev
    };

NodeSa: PROC = {OPEN defaultHandle^;
    slist.selectedSample.isNode _ PopBoolean[];
    IF ~slist.selectedSample.isNode THEN slist.selectedSample.isCusp _ FALSE;
    };

CuspSa: PROC = {OPEN defaultHandle^; slist.selectedSample.isCusp _ slist.selectedSample.isNode _ PopBoolean[]};

CuspNode: PROC = {OPEN defaultHandle^; IF slist.selectedSample.isNode THEN slist.selectedSample.isCusp _ PopBoolean[]};

GetVec: PROC RETURNS [z:Complex.Vec] = {z.y _ GetReal[]; z.x _ GetReal[]};

TanSa: PROC = {defaultHandle.slist.selectedSample.tangent _ GetVec[]};
TanOutSa: PROC = {defaultHandle.slist.selectedSample.tanOut _ GetVec[]};

ScaleSa: PROC = {OPEN defaultHandle^;
    z: Complex.Vec _ GetVec[];
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        p:Complex.Vec _ s.xy;
        s.xy _ Complex.Mul[p,z];
        p _ s.tangent;
        s.tangent _ Complex.Mul[p,z];
        ENDLOOP;
    };

TranSa: PROC = {OPEN defaultHandle^;
    z: Complex.Vec _ GetVec[];
    FOR s: SampleHandle _ slist.header.next, s.next UNTIL s=slist.header DO
        s.xy _ Complex.Add[s.xy,z];
        ENDLOOP;
    };

InterpolateSa: PROC = {OPEN defaultHandle^;
    mindelta: REAL _ MAX[GetReal[], 0.00001];
    s: SampleHandle _ slist.header.next;
    UNTIL s=slist.header DO
        nexts: SampleHandle _ s.next;
        nextxy: Complex.Vec _ (IF s.next = slist.header THEN slist.header.next ELSE s.next).xy;
        delta: Complex.Vec _ Complex.Sub[nextxy, s.xy];
        k: REAL _ Real.RoundLI[Complex.Abs[delta]/mindelta];
        FOR i: REAL _ 1, i+1 UNTIL i>k DO
            InsertBefore[Complex.Add[s.xy, Vector.Mul[delta, i/(k+1)]], nexts];
            ENDLOOP; 
        s _ nexts;
        ENDLOOP;
    }; 

PrintReal: PROC[r: REAL] = {OPEN IO; Put[stream,real[r],char[SP]]};
PrintString: PROC[s: LONG STRING] = {OPEN IO; Put[stream,string[s]]};
PrintLine: PROC[s: LONG STRING] = {OPEN IO; Put[stream,string[s],char[CR]]};
PrintPoint: PROC[pt: Complex.Vec] = {PrintReal[pt.x]; PrintReal[pt.y]};

cp: Complex.Vec _ [0,0];

thePath: Graphics.Path _ Graphics.NewPath[300];

MoveTo: PUBLIC PROC[dc: Graphics.Context, p: Complex.Vec] = {
    Graphics.SetColor[dc,Graphics.black];
    [] _ Graphics.SetFat[dc,TRUE];
    p _ XForm[p];
    Graphics.MoveTo[thePath,p.x,p.y];
    Graphics.SetCP[dc, p.x,p.y];
    IF typescript THEN {
        PrintLine["\nbeginoutline"];
        PrintPoint[p];
        IF fill THEN PrintLine["moveto"] ELSE PrintLine["setcp"];
        };
    cp _ p;
    };
 
DrawTo: PUBLIC PROC[dc: Graphics.Context, p: Complex.Vec] = {
    p _ XForm[p];
    Graphics.DrawTo[dc, p.x,p.y];
    IF typescript THEN {PrintPoint[p]; PrintString["drawto "]};
    cp _ p;
    };

LineTo: PROC[dc: Graphics.Context, p: Complex.Vec] = {
    p _ XForm[p];
    Graphics.LineTo[thePath, p.x,p.y];
    Graphics.SetCP[dc, p.x,p.y];
    IF typescript THEN {
        IF fill THEN {PrintPoint[p]; PrintString["lineto "]}
        ELSE {PrintPoint[p]; PrintString["drawto "]};
        };
    cp _ p;
    };

DrawLine: PUBLIC PROC[from, to: Complex.Vec] = {
    Paint: PROC[dc: Graphics.Context] = {
        MoveTo[dc,from];
        DrawTo[dc,to];
        };
    TJaMGraphics.Painter[Paint];
    };
 
DrawCubic: PROC[dc: Graphics.Context, b: Cubic.Bezier] = {
    oldfill: BOOLEAN _ fill;
    fill _ FALSE;
    MoveTo[dc,b.b0];
    CurveTo[dc,b.b1,b.b2,b.b3];
    DrawPath[dc,0];
    fill _ oldfill
    };
 
CurveTo: PROC[dc: Graphics.Context, p1,p2,p3: Complex.Vec] = {
    p1 _ XForm[p1];
    p2 _ XForm[p2];
    p3 _ XForm[p3];
    Graphics.CurveTo[thePath,p1.x,p1.y,p2.x,p2.y,p3.x,p3.y];
    Graphics.SetCP[dc, p3.x,p3.y];
    IF typescript THEN {
        IF fill THEN {
          PrintPoint[p1];
          PrintPoint[p2];
          PrintPoint[p3];
          PrintLine["curveto"];
          }
        ELSE {
          PrintPoint[cp];
          PrintPoint[p1];
          PrintPoint[p2];
          PrintPoint[p3];
          PrintLine["bezier"];
          };
        };
    cp _ p3;
    };
 
DrawPath: PROC[dc: Graphics.Context, width: REAL] = {
    Graphics.DrawStroke[dc,thePath,width];
    };
 
DrawArea: PROC[dc: Graphics.Context, parityFill: BOOLEAN _ FALSE] = {
    Graphics.DrawArea[dc,thePath,parityFill];
    IF typescript AND fill THEN PrintLine["endoutline"];
    };

sLen: REAL _ 0;
SetSLen: PROC = {sLen _ GetReal[]};

fill: BOOLEAN _ FALSE;
SetFill: PROC = {fill _ PopBoolean[]};
 
scale: REAL _ 1;
SetScale: PROC = {scale _ GetReal[]};

offset: Complex.Vec _ [0,0];
SetOffset: PROC = {offset.y _ GetReal[]; offset.x _ GetReal[]};

XForm: PROC[v: Complex.Vec] RETURNS[vt: Complex.Vec] =
    {vt.x _ v.x*scale+offset.x; vt.y _ v.y*scale+offset.y};
IXForm: PROC[v: Complex.Vec] RETURNS[vt: Complex.Vec] =
    {vt.x _ (v.x-offset.x)/scale; vt.y _ (v.y+offset.y)/scale};

typescript: BOOLEAN _ FALSE;
SetTypescript: PROC = {
    typescript _ PopBoolean[];
    IF typescript AND stream=NIL THEN {
        typescript _ FALSE;
        JaMFnsDefs.JaMExec["(no log file) .print"];
        };
    };

Note: PROC = {
    c: LONG STRING _ [80];
    PopString[c];
    IF typescript THEN PrintString[c];
    };

Notes: PROC = {
    c: LONG STRING _ [80];
    PopString[c];
    IF typescript THEN {PrintString[c]; PrintString[" "]};
    };

Noter: PROC = {
    c: LONG STRING _ [80];
    PopString[c];
    IF typescript THEN {PrintLine[c]; stream.Flush[]};
    };
 Time: PROC = {
     IF typescript THEN {IO.Put[stream,IO.time[]]; stream.Flush[]};
    };


defaultHandle: PUBLIC Handle _ Create[];
[] _ Visible[defaultHandle];

JaMFnsDefs.Register[".startsa", StartSa];
JaMFnsDefs.Register[".resetsa", ResetSa];
JaMFnsDefs.Register[".addsa", AddSa];
JaMFnsDefs.Register[".countsa", CountSa];
JaMFnsDefs.Register[".foralllinks", ForAllLinks];
JaMFnsDefs.Register[".nextcon", NextCon];
JaMFnsDefs.Register[".resetcon", ResetCon];
JaMFnsDefs.Register[".addcon", AddCon];
JaMFnsDefs.Register[".countcon", CountCon];
JaMFnsDefs.Register[".interpolatesa", InterpolateSa]; -- d => . Interpolates samples to make deltas no larger than about d
JaMFnsDefs.Register[".drawsa", DrawSamples];
JaMFnsDefs.Register[".marksa", MarkSamples];
JaMFnsDefs.Register[".drawli", DrawLinks];
JaMFnsDefs.Register[".markli", MarkLinks];
JaMFnsDefs.Register[".marknodes", MarkNodes];
JaMFnsDefs.Register[".setslen", SetSLen];
JaMFnsDefs.Register[".setfill", SetFill];
JaMFnsDefs.Register[".setlog", SetTypescript];
JaMFnsDefs.Register[".setscale", SetScale];
JaMFnsDefs.Register[".setoffset", SetOffset];
JaMFnsDefs.Register[".setmarksize", SetMarkSize];
JaMFnsDefs.Register[".note", Note];
JaMFnsDefs.Register[".notes", Notes];
JaMFnsDefs.Register[".noter", Noter];
JaMFnsDefs.Register[".time", Time];

-- Sample Editing Commands
JaMFnsDefs.Register[".selectsa", SelectSa]; -- x y => . Selects a sample point for editing
JaMFnsDefs.Register[".thesa", TheSa]; -- => x y . Returns the current sample
JaMFnsDefs.Register[".thetan", TheTan]; -- => x y boolean . Returns the tangent of the current sample, and whether it is a node
JaMFnsDefs.Register[".deletesa", DeleteSa]; -- =>  . Deletes the current sample
JaMFnsDefs.Register[".insertsa", InsertSa]; -- x y => . Inserts before the current sample
JaMFnsDefs.Register[".insertbetween", InsertBetween]; -- x y => . Inserts between the current sample and the neighbor nearest the 
new point
JaMFnsDefs.Register[".nodesa", NodeSa]; -- boolean => . Makes or unmakes a node
JaMFnsDefs.Register[".tansa", TanSa]; -- deltax deltay => . Sets the tangent at a sample
JaMFnsDefs.Register[".cuspsa", CuspSa]; -- boolean => . Makes or unmakes a cusp
JaMFnsDefs.Register[".cuspnode", CuspNode]; -- boolean => . Makes or unmakes a cusp ONLY on a node
JaMFnsDefs.Register[".tanoutsa", TanOutSa]; -- deltax deltay => . Sets the outgoing tangent
JaMFnsDefs.Register[".homesa", HomeSa]; -- => . Selects the header
JaMFnsDefs.Register[".makefirstsa", MakeFirstSa]; -- => . Selects the header
JaMFnsDefs.Register[".nextsa", NextSa]; -- => x y . Moves selection to the next sample
JaMFnsDefs.Register[".prevsa", PrevSa]; -- => x y . Moves selection to the previous sample
JaMFnsDefs.Register[".scalesa", ScaleSa]; -- x y =>  . Scales/rotates all samples by multiplying by x+iy
JaMFnsDefs.Register[".transa", TranSa]; -- x y =>  . Translates all samples by adding x+iy
JaMFnsDefs.Register[".subrange", Subrange]; -- change CurrentSamples so it returns a subrange
JaMFnsDefs.Register[".allsa", NoSubrange]; -- remove the subrange
JaMFnsDefs.Register[".resetnodes", ResetDefaultNodes]; -- remove the nodes
JaMFnsDefs.Register[".resetcusps", ResetDefaultCusps]; -- remove the cusps
JaMFnsDefs.Register[".openlogfile", OpenLogFile]; -- filename => . Switches the log file.
JaMFnsDefs.Register[".closelogfile", CloseLogFile]; -- => . Closes the log file.

END.

Michael Plass  August 13, 1982 9:48 am: Added multiple sample sets, InsertBetween.
Michael Plass  August 13, 1982 10:29 am: Added CornerSa.
Michael Plass  August 23, 1982 9:59 am: Added ForAllLinks.
Michael Plass  August 23, 1982 2:31 pm: Sent Curve.Log to file.

Michael Plass  August 23, 1982 2:34 pm: CornerSa moved out because of Storage overflow in Pass 3.
CornerSa: PROC = {OPEN Vector;
    samp: SampleHandle _ IF defaultHandle.slist.selectedSample = defaultHandle.slist.header THEN 
defaultHandle.slist.selectedSample.next ELSE defaultHandle.slist.selectedSample;
    p: SampleHandle _ IF samp.prev = defaultHandle.slist.header THEN samp.prev.prev ELSE samp.prev;
    pp: SampleHandle _ IF p.prev = defaultHandle.slist.header THEN p.prev.prev ELSE p.prev;
    n: SampleHandle _ IF samp.next = defaultHandle.slist.header THEN samp.next.next ELSE samp.next;
    nn: SampleHandle _ IF n.next = defaultHandle.slist.header THEN n.next.next ELSE n.next;
    a: Vec _ pp.xy;
    b: Vec _ p.xy;
    c: Vec _ nn.xy;
    d: Vec _ n.xy;
    coeffMat: Matrix _ [a.y-b.y, b.x-a.x, c.y-d.y, d.x-c.x];
    r: Vec _ [Det[[b.x, b.y, a.x, a.y]], Det[[d.x, d.y, c.x, c.y]]];
    denom: REAL _ Det[coeffMat];
    xTimesDenom: REAL _ Det[[r.x, coeffMat.a12, r.y, coeffMat.a22]];
    yTimesDenom: REAL _ Det[[coeffMat.a11, r.x, coeffMat.a21, r.y]];
    IF denom=0 THEN RETURN;
    samp.xy.x _ xTimesDenom/denom;
    samp.xy.y _ yTimesDenom/denom;
    };
JaMFnsDefs.Register[".cornersa", CornerSa]; -- => . moves the selected sample so it is colinear with its two left neightbors and 
with its two right neighbors

Michael Plass  August 24, 1982 9:48 am: Removed Curve.Log typescript.
Michael Plass  August 27, 1982 7:21 pm: Bulletproofed against empty links.
Michael Plass  August 30, 1982 1:33 pm: Added OpenLogFile.
Michael Plass  September 28, 1982 12:26 pm: Added CloseLogFile.
Michael Plass  December 7, 1982 10:25 am: Took out Transaction import for 3.5.