-- 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𡤏irst, 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.