--M. Stone September 26, 1980  5:42 PM
--subdivision, patricks test for change in tangent
-- Last Edited by: Stone, February 9, 1983 4:52 pm
DIRECTORY
	RealFns: FROM "RealFns",
	SplineDefs: FROM "SplineDefs",
	PressLineDefs: FROM "PressLineDefs",
	GriffinMemoryDefs USING [CZone],
	PointDefs: FROM "PointDefs";

PressLines: PROGRAM
IMPORTS RealFns,SplineDefs, GriffinMemoryDefs
EXPORTS PressLineDefs=
BEGIN OPEN PointDefs,PressLineDefs, GriffinMemoryDefs;

--calling proc must START Float and Init Splines

diff,eps,magtstart,W,deltaT: REAL;
prec: INTEGER _ 20;
t,p,start,tstart,next: ObjPt;
firstpt: ObjPt;
end,End0: End;
PutCurve: PutProc;
lastx,lasty,Tol: REAL;
ONE: REAL _ 1; E2: REAL _ 100;
half: REAL _ ONE/2;
Vals: TYPE= 
	RECORD[Fx,Cx,Tx: REAL, Fy,Cy,Ty: REAL];

RABS: PROCEDURE[r: REAL] RETURNS [REAL] = INLINE BEGIN
IF r<0 THEN RETURN[-r] ELSE RETURN[r];
END;

ContourCubic: PUBLIC PROCEDURE[coeffs: SplineDefs.Coeffs, w: REAL, end0,end1: End, putCurve: PutProc]=
BEGIN
p0,p1,t0,t1: ObjPt;
i: CARDINAL;
val0,val1: Vals;
dtanx,dtany: REAL;
zeropt: ObjPt _ [0,0];
FOR i IN [X..Y] DO
	p0[i] _ coeffs.t0[i];
	p1[i] _ coeffs.t0[i]+coeffs.t1[i]+coeffs.t2[i]+coeffs.t3[i];
	t0[i] _ coeffs.t1[i];
	t1[i] _ coeffs.t1[i]+2*coeffs.t2[i]+3*coeffs.t3[i];
	ENDLOOP;
--do lines directly
IF coeffs.t3=coeffs.t2 AND coeffs.t2=zeropt THEN BEGIN
	ContourLine[p0,p1,w,end0,end1,putCurve];
	RETURN;
	END;
firstpt _ p0;
start _ p0;
tstart _ t0;
deltaT _ 0;
magtstart _ tstart[X]*tstart[X]+tstart[Y]*tstart[Y];
--can't run the algorithm with magtstart=0.   Is probably a badly parameterized
--Bezier curve.  Punt
IF magtstart=0 THEN BEGIN
	ContourLine[p0,p1,w,end0,end1,putCurve];
	RETURN;
	END;
End0_ end0; 
W _ w;
eps _ prec/E2;	--from Draw
PutCurve _ putCurve;

--set initial values.  assume  t0=0, t1=1 
--F[0], F[1], T[0],T[1], C _ (6at+2b)/2
--d is 1/2, but things will be div by 4 first time thru, so don't divide here
	val0.Fx _  p0[X];
	val0.Tx _  t0[X];
	val0.Cx _  coeffs.t2[X];
	val0.Fy _  p0[Y];
	val0.Ty _  t0[Y];
	val0.Cy _  coeffs.t2[Y];
	
	lastx _ val1.Fx _  p1[X];
	val1.Tx _  t1[X];
	val1.Cx _  (3*coeffs.t3[X]+coeffs.t2[X]);
	lasty _ val1.Fy _  p1[Y];
	val1.Ty _  t1[Y];
	val1.Cy _  (3*coeffs.t3[Y]+coeffs.t2[Y]);
	
	dtanx _  (3*coeffs.t3[X]);	
	dtany _  (3*coeffs.t3[Y]);
	Tol _  2*w;
DrawCurve[val0, val1,dtanx,dtany,1]
END;

--recursive subdivision
DrawCurve: PROCEDURE[val1,val2: Vals, dtanX,dtanY: REAL, thisT: REAL ]=
BEGIN
DO
SELECT TRUE FROM
--is small or flat.  check tangent
(RABS[val1.Cx] < half AND RABS[val1.Cy] < half AND RABS[val2.Cx] < half AND RABS[val2.Cy] < half) OR (RABS[val1.Fx-val2.Fx] <=Tol AND RABS[val1.Fy-val2.Fy] <=Tol)=> BEGIN
	deltaT _ deltaT+thisT;
	t[X] _  val2.Tx;
	t[Y] _ val2.Ty;
	diff _ ABS[(t[Y]*tstart[X]-t[X]*tstart[Y])/magtstart];
	IF diff< eps AND (RABS[lastx-val2.Fx]>=1 OR RABS[lasty-val2.Fy]>=1)
		THEN RETURN;
	p[X] _ val2.Fx;
	p[Y] _  val2.Fy;
	end _ (IF p=firstpt THEN End0 ELSE round);
--scale the tangents
	next _ t;
	t[X] _ t[X]*deltaT; t[Y] _t[Y]*deltaT;
	tstart[X] _ tstart[X]*deltaT; tstart[Y] _tstart[Y]*deltaT;
	ContourCurve[start,p,tstart,t,W,end,round,PutCurve];
	start _ p;
	tstart _ next;
	deltaT _ 0;
	magtstart _ tstart[X]*tstart[X]+tstart[Y]*tstart[Y];
	RETURN;
	END;
ENDCASE => BEGIN
	valc: Vals;
	thisT _ thisT/2;
	val1.Cx _ val1.Cx/4; val2.Cx _ val2.Cx/4;
	valc.Cx _ (val1.Cx+val2.Cx)/2;
	valc.Fx _ ((val1.Fx+val2.Fx)/2) - valc.Cx;

	val1.Cy _ val1.Cy/4; val2.Cy _ val2.Cy/4;
	valc.Cy _ (val1.Cy+val2.Cy)/2;
	valc.Fy _ ((val1.Fy+val2.Fy)/2) - valc.Cy;

	dtanX _ dtanX/4; dtanY _ dtanY/4;
	valc.Tx _ ((val1.Tx+val2.Tx)/2) - dtanX;
	valc.Ty _ ((val1.Ty+val2.Ty)/2) - dtanY;
	DrawCurve[val1,valc,dtanX,dtanY,thisT];
	val1 _valc;	--instead of a second call to DrawCurve
	END;
ENDLOOP;
END;

ContourCurve: PROCEDURE[p0,p1,t0,t1: ObjPt, w: REAL, end0,end1: End, putCurve: PutProc]=
BEGIN
length: REAL;
nx0,ny0,nx1,ny1: REAL;
coeffs: SplineDefs.Coeffs;
ncoeffs: SplineDefs.CoeffsSequence;  --used by makespline
pt0,pt1: ObjPt;
knots: SplineDefs.KnotSequence _ CZone.NEW[SplineDefs.KnotSequenceRec[4]];
length _ RealFns.SqRt[t0[X]*t0[X]+t0[Y]*t0[Y]];
IF length = 0 THEN BEGIN t0[X] _ 1; t0[Y] _ 0; length _ 1; END;
ny0 _ w*t0[X]/length;
nx0 _ -w*t0[Y]/length;
--[nx0,ny0] is a vector normal to t0, w long
length _ RealFns.SqRt[t1[X]*t1[X]+t1[Y]*t1[Y]];
IF length = 0 THEN BEGIN t1[X] _ 1; t1[Y] _ 0; length _ 1; END;
ny1 _ w*t1[X]/length;
nx1 _ -w*t1[Y]/length;
--[nx1,ny1] is a vector normal to t1, w long
pt0 _ [p0[X]+nx0,p0[Y]+ny0];
IF end0=square THEN pt0 _ [pt0[X]-ny0,pt0[Y]+nx0];	--move it back a unit
pt1 _ [p1[X]+nx1,p1[Y]+ny1];
IF end1=square THEN pt1 _ [pt1[X]+ny1,pt1[Y]-nx1];	--move it up a unit
coeffs _ MakeCoeffs[pt0,pt1,t0,t1];
putCurve[coeffs,TRUE];	--start new object

--first end
SELECT end1 FROM
	flat,square => BEGIN
		coeffs.t0 _ pt1;
		coeffs.t1 _ [-2*nx1,-2*ny1];
		coeffs.t3 _ coeffs.t2 _ [0,0];
		pt1 _ [pt1[X]+coeffs.t1[X],pt1[Y]+coeffs.t1[Y]];
		END;
	round => BEGIN
		knots[0] _ pt1;
		knots[3] _ [p1[X]-nx1,p1[Y]-ny1];
		knots[1] _ [knots[0][X]+ny1*4/3,knots[0][Y]-nx1*4/3];
		knots[2] _ [knots[3][X]+ny1*4/3,knots[3][Y]-nx1*4/3];
		ncoeffs _ SplineDefs.MakeSpline[knots,bezier];
		coeffs _ ncoeffs[0];
		pt1 _ knots[3];
		END;
	ENDCASE;
putCurve[coeffs,FALSE];

--second side
pt0 _ [p0[X]-nx0,p0[Y]-ny0];
IF end0=square THEN pt0 _ [pt0[X]-ny0,pt0[Y]+nx0];	--move it back a unit
t0 _ [-t0[X],-t0[Y]];
t1 _ [-t1[X],-t1[Y]];
coeffs _ MakeCoeffs[pt1,pt0,t1,t0];
putCurve[coeffs,FALSE];

--second end
SELECT end0 FROM
	flat,square => BEGIN
		coeffs.t0 _ pt0;
		coeffs.t1 _ [2*nx0,2*ny0];
		coeffs.t3 _ coeffs.t2 _ [0,0];
		END;
	round => BEGIN
		knots[0] _ pt0;
		knots[3] _ [p0[X]+nx0,p0[Y]+ny0];
		knots[1] _ [knots[0][X]-ny0*4/3,knots[0][Y]+nx0*4/3];
		knots[2] _ [knots[3][X]-ny0*4/3,knots[3][Y]+nx0*4/3];
		ncoeffs _ SplineDefs.MakeSpline[knots,bezier];
		coeffs _ ncoeffs[0];
		END;
	ENDCASE;
putCurve[coeffs,FALSE];
END;

--2 points and 2 tangents to make a curve (Hermite)
MakeCoeffs: PROCEDURE[p0,p1,t0,t1: ObjPt] RETURNS[coeffs: SplineDefs.Coeffs] =
BEGIN
i: CARDINAL;
FOR i IN [X..Y] DO
	coeffs.t3[i] _ 2*p0[i]-2*p1[i]+t0[i]+t1[i];
	coeffs.t2[i] _ -3*p0[i]+3*p1[i]-2*t0[i]-t1[i];
	coeffs.t1[i] _ t0[i];
	coeffs.t0[i] _ p0[i];
	ENDLOOP;
END;

ContourLine: PUBLIC PROCEDURE[p0,p1: ObjPt, w: REAL, end0,end1: End, putCurve: PutProc]=
BEGIN
length: REAL;
dx,dy,nx,ny: REAL;
coeffs: SplineDefs.Coeffs;
ncoeffs: SplineDefs.CoeffsSequence;  --used by makespline
pt: ObjPt;
knots: SplineDefs.KnotSequence _ CZone.NEW[SplineDefs.KnotSequenceRec[4]];
dx _ p1[X]-p0[X];
dy _ p1[Y]-p0[Y];
length _ RealFns.SqRt[dx*dx+dy*dy];
IF length = 0 THEN BEGIN dx _ 1; dy _ 0; length _ 1; END;
ny _ w*dx/length;
nx _ -w*dy/length;
--[nx,ny] is a vector normal to the line, w long
coeffs _ [[0,0],[0,0],[0,0],[0,0]];
coeffs.t0 _ [p0[X]+nx,p0[Y]+ny];
IF end0=square THEN coeffs.t0 _ [coeffs.t0[X]-ny,coeffs.t0[Y]+nx];	--move it back a unit
pt _ [p1[X]+nx,p1[Y]+ny];
IF end1=square THEN pt _ [pt[X]+ny,pt[Y]-nx];	--move it up a unit
coeffs.t1 _ [pt[X]-coeffs.t0[X], pt[Y]-coeffs.t0[Y]];
putCurve[coeffs,TRUE];	--start new object

--first end
SELECT end1 FROM
	flat,square => BEGIN
		coeffs.t0 _ pt;
		coeffs.t1 _ [-2*nx,-2*ny];
		pt _ [pt[X]+coeffs.t1[X],pt[Y]+coeffs.t1[Y]];
		END;
	round => BEGIN
		knots[0] _ pt;
		knots[3] _ [p1[X]-nx,p1[Y]-ny];
		knots[1] _ [knots[0][X]+ny*4/3,knots[0][Y]-nx*4/3];
		knots[2] _ [knots[3][X]+ny*4/3,knots[3][Y]-nx*4/3];
		ncoeffs _ SplineDefs.MakeSpline[knots,bezier];
		coeffs _ ncoeffs[0];
		pt _ knots[3];
		END;
	ENDCASE;
putCurve[coeffs,FALSE];

--second side
coeffs _ [[0,0],[0,0],[0,0],[0,0]];
coeffs.t0 _ pt;
pt _ [p0[X]-nx,p0[Y]-ny];
IF end0=square THEN pt _ [pt[X]-ny,pt[Y]+nx];	--move it back a unit
coeffs.t1 _ [pt[X]-coeffs.t0[X], pt[Y]-coeffs.t0[Y]];
putCurve[coeffs,FALSE];

--second end
SELECT end0 FROM
	flat,square => BEGIN
		coeffs.t0 _ pt;
		coeffs.t1 _ [2*nx,2*ny];
		END;
	round => BEGIN
		knots[0] _ pt;
		knots[3] _ [p0[X]+nx,p0[Y]+ny];
		knots[1] _ [knots[0][X]-ny*4/3,knots[0][Y]+nx*4/3];
		knots[2] _ [knots[3][X]-ny*4/3,knots[3][Y]+nx*4/3];
		ncoeffs _ SplineDefs.MakeSpline[knots,bezier];
		coeffs _ ncoeffs[0];
		END;
	ENDCASE;
putCurve[coeffs,FALSE];
END;

END.

Ę‘˜JšľĎcZĎk<œžœžœžœ%žœžœžœ
žœ'žœžœ
žœ.1œž
œ	žœžœhžœžœžœ
žœžœžœ
žœžœžœžœžœž	œžœžœžœžœ
žœ
žœžœ
žœžœ
žœžœĎnœžœ
ž	œžœ&žœžœ žœžœžœž
œž
œžœŁ
žœžœžœžœ
žœ,žœžœHž
œ	ž
œ	ž
œ	ž
œfžœ
žœ
žœ,žœžœž
œœĄ
œž
œž
œž
œž
œž
œž
œž
œž
œž
œž
œž
œž
œž
œž
œž
œž
œ5žœŸ	œž	œžœ	žœžœ
žœ
žœ
žœ
žœ
#œ
žœžœ
žœžœ
žœžœ
žœžœžœžœ
žœžœž
œž
œžœž
œ	ž
œž
œ	ž
œžœžœžœžœ
žœžœ
žœž
œž
œžœžœžœ	œž
œž
œž
œž
œž
œž
œž
œ
ž
œ)ž
œSž
œ	ž
œ	ž
œ	ž
œžœžœžœžœ˝(œ
žœžœžœŸœž	œžœ&žœ	žœžœBœ7žœ:ž
œž
œž
œž
œžœžœ
žœž
œ
ž
œžœ
ž
œž
œ
-œž
œž
œž
œž
œžœžœ
žœž
œ
ž
œžœ
ž
œž
œ
-œ
ž
œ	ž
œžœ
žœž
œ
ž
œœ
ž
œ	ž
œžœ
žœž
œ
ž
œœ4žœœ
žœžœžœaž
œž
œž
œž
œžœžœ$ž
œ	ž
œž
œž
œ#ž
œž
œhžœžœžœœ
ž
œ	ž
œžœ
žœž
œ
ž
œœ
ž
œž
œž
œž
œ8žœ
žœžœžœTžœžœ$ž
œ	ž
œž
œž
œ#ž
œž
œVžœžœžœžœ4Ÿ
œž	œžœžœžœžœžœž
œž
œžœ
žœžœŸœžœ
ž	œžœ&žœ	žœžœBœ2žœ)ž
œž
œž
œž
œ'žœžœ
žœžœ'1œ4ž
œž
œžœ
žœž
œž
œœ	ž
œž
œžœ
žœ
ž
œž
œœž
œž
œž
œž
œžœœ
žœžœžœ;ž
œž
œž
œž
œžœžœ#ž
œž
œž
œž
œ"ž
œž
œfžœžœžœœ=ž
œž
œžœ
žœ
ž
œž
œœž
œž
œž
œž
œžœ
žœžœžœ0žœžœ#ž
œž
œž
œž
œ"ž
œž
œUžœžœžœžœžœ˜@—…— %Š