// April 14, 1978  3:38 PM				*** overlay C ***


get "zpDefs.bcpl"

get "zpPressDf.bcpl"


// outgoing procedures:

external [
	WriteDLline
	WriteDLdot
	GetThickness
	ScaleKnotTable
	MakeCubic
	ComputeNormal
	]

// incoming procedures:

external [
	Puts			// SYSTEM
	Gets
	WriteBlock
	MoveBlock

	FLD; FLDI; FST		// FLOAT
	FTR; FML; FDV
	FAD; FNEG; FSB; FCM; FSN
	FSTDP; FLDDP; DPAD

	confirm			// ZPUTIL
	sTypeForm
	typeForm
	getLine
	SquareRoot

	obtainBlock		// ZPBLOCK
	putBlock
	giveUp

	PutsCurve		// ZPPUTS
	PutsMove
	PutsLine
	PutsRoundTip

	PutObjectInELtable	// ZPPRESS
	PutRectangleInELtable
	PrintFpValues
	]

// local statics

// incoming statics:

external [
	keys			// SYSTEM

	@dashOn			// ZPDRAW
	@dashOff

	@lineThicknessTable	// ZPINIT1

	@showValues		// ZPPRESS
	]



// local floating point registers

manifest [
	t0=0; t1=1; t2=2; t3=3; t4=4
	]




let WriteDLdot(pressFile, splinePointer, sLeft, sBottom) = valof [
	let xTable=vec 4
	let yTable=xTable+2
	MoveBlock(xTable, splinePointer+SPLINEknotBase, 4)
	ScaleKnotTable(xTable, yTable, 1, scaleFactor, sLeft, sBottom)
	resultis WriteDotObject(pressFile, xTable, yTable,
		splinePointer>>SPLINE.shape, GetThickness(splinePointer))
	]



and WriteDotObject(pressFile, xTable, yTable, brushShape, thickness) = valof [
	FLDI(t0, thickness)
	if brushShape eq rBrush then [
	// dot has a circular shape
	// circle approximation is obtained by the following cubic parametrization
	// cos(pi/2 t)= .4298 t↑3 - 1.4666 t↑2 + 0.0368 t + 1
	// sin(pi/2 t)= - .4298 t↑3 - .1772 t↑2 + 1.6070 t
		FLD(t1, xTable); FAD(t1, t0); let x0=FTR(t1)
		FLD(t1, yTable); let y0=FTR(t1)
		FLDI(t2, 10000); FDV(t0, t2)
		let xa=vec 2; FLDI(t1, 4298); FML(t1, t0); FST(t1, xa)
		let ya=vec 2; FNEG(t1); FST(t1, ya)
		let nxb=vec 2; FLDI(t1, 14666); FML(t1, t0); FST(t1, nxb)
		let xb=vec 2; FNEG(t1); FST(t1, xb)
		let nyb=vec 2; FLDI(t1, 1772); FML(t1, t0); FST(t1, nyb)
		let yb=vec 2; FNEG(t1); FST(t1, yb)
		let xc=vec 2; FLDI(t1, 368); FML(t1, t0); FST(t1, xc)
		let nxc=vec 2; FNEG(t1); FST(t1, nxc)
		let yc=vec 2; FLDI(t1, 16070); FML(t1, t0); FST(t1, yc)
		let nyc=vec 2; FNEG(t1); FST(t1, nyc)
		resultis WriteCircleObject(pressFile,
				x0, y0, xa, ya, xb, yb, xc, yc, nxb, nyb, nxc, nyc)
		]

	// dot has a rectangular shape
	let dX=vec 2; let dY=vec 2
	FLDI(t1, lineThicknessTable!0)
	switchon brushShape into [
	case sBrush:
		FST(t0, dX); FST(t0, dY)
		endcase
	case hBrush:
		FST(t0, dX); FST(t1, dY)
		endcase
	case vBrush:
		FST(t0, dY); FST(t1, dX)
		endcase
	default:
		FLDI(t0, 0); FST(t0, dX); FST(t0, dY)
		endcase
		]
	// x0=x1=x+dx
	FLD(t0, xTable); FAD(t0,dX); let x0=FTR(t0)
	// x2=x3=x-dx
	FLD(t0, xTable); FSB(t0,dX); let x2=FTR(t0)
	// y0=y3=y+dy
	FLD(t0, yTable); FAD(t0,dY); let y0=FTR(t0)
	// y1=y2=y-dy
	FLD(t0, yTable); FSB(t0,dY); let y1=FTR(t0)
	resultis WriteStripeObject(pressFile, x0, y0, x0, y1, x2, y1, x2, y0)
	]



and WriteCircleObject(pressFile, x0, y0, xa, ya, xb, yb, xc, yc, nxb, nyb, nxc, nyc) =
valof [WriteCircleObject
	// CIRCULAR OBJECT
	// x0 & y0 are starting point of circle (integer)
	// xa,...,yc are cubic coefficients (floating point)
	// nxb,...,nyc are the negative of the same coefficients
	// (exception: xa=-ya)
	let objectWordCount=0
	PutsMove(pressFile, lv objectWordCount, x0, y0)
	PutsCurve(pressFile, lv objectWordCount, xc, yc, xb, yb, xa, ya)
	PutsCurve(pressFile, lv objectWordCount, nyc, xc, nyb, xb, xa, xa)
	PutsCurve(pressFile, lv objectWordCount, nxc, nyc, nxb, nyb, ya, xa)
	PutsCurve(pressFile, lv objectWordCount, yc, nxc, yb, nxb, ya, ya)
	resultis PutObjectInELtable(objectWordCount)
	]WriteCircleObject



and WriteDLline(pressFile, splinePointer, sLeft, sBottom) = valof [
	let thickness=GetThickness(splinePointer)
	let xTable=vec 4
	let yTable=vec 4
	MoveBlock(xTable, splinePointer+SPLINEknotBase, 4)
	MoveBlock(yTable, splinePointer+SPLINEknotBase+4, 4)
	ScaleKnotTable(xTable, yTable, 2, scaleFactor, sLeft, sBottom)
	let brushShape=splinePointer>>SPLINE.shape
	let splineType=splinePointer>>SPLINE.type
	FLD(t0, xTable); FLD(t1, yTable)
	if FCM(t0, xTable+2) eq 0 & FCM(t1, yTable+2) eq 0 then
		resultis WriteDotObject(pressFile, xTable, yTable, brushShape, thickness)

	test splinePointer>>SPLINE.dashed
	ifnot resultis WriteLineObject(pressFile, xTable, yTable,
				brushShape, splineType, thickness)
	ifso [
		let objectWordCount=0
		let Xon=vec 2; let Yon=vec 2; let Xoff=vec 2; let Yoff=vec 2
		FLD(t0, xTable+2)
		let Xcomp=FCM(t0, xTable); FSB(t0, xTable); FLD(t2, t0); FML(t2, t0)
		FLD(t1, yTable+2)
		let Ycomp=FCM(t1, yTable); FSB(t1, yTable); FLD(t3, t1); FML(t3, t1)
		let temp=vec 2; FAD(t2, t3); FST(t2, temp); SquareRoot(temp)
		FDV(t0, temp); FDV(t1, temp); FLD(t2, t0); FLD(t3, t1)
		FLDI(t4, dashOn*scaleFactor)
		FML(t0, t4); FST(t0, Xon)
		FML(t1, t4); FST(t1, Yon)
		FLDI(t4, dashOff*scaleFactor)
		FML(t2, t4); FST(t2, Xoff)
		FML(t3, t4); FST(t3, Yoff)
		let xxTable=vec 4; let yyTable=vec 4
		MoveBlock(xxTable, xTable, 4)
		MoveBlock(yyTable, yTable, 4)
		[ FLD(t0, xxTable); FAD(t0, Xon)
		  FLD(t1, yyTable); FAD(t1, Yon)
		  if (Xcomp & (FCM(t0, xTable+2) eq Xcomp)) %
		     (Ycomp & (FCM(t1, yTable+2) eq Ycomp)) then [
				FLD(t0, xTable+2); FLD(t1, yTable+2)
				]
		  FST(t0, xxTable+2); FST(t1, yyTable+2)
		  objectWordCount=objectWordCount + WriteLineObject(pressFile,
				xxTable, yyTable, brushShape, splineType, thickness)
		  FLD(t0, xxTable+2); FAD(t0, Xoff)
		  FLD(t1, yyTable+2); FAD(t1, Yoff)
		  if ((FCM(t0, xTable+2) eq 0) & (FCM(t1, yTable+2) eq 0)) %
			(Xcomp & (FCM(t0, xTable+2) eq Xcomp)) %
			(Ycomp & (FCM(t1, yTable+2) eq Ycomp)) resultis objectWordCount
		  FST(t0, xxTable); FST(t1, yyTable)
		  ] repeat
		]
	]



and WriteLineObject(pressFile, xTable, yTable, brushShape, splineType, thickness) = valof [
	let tX=vec 2; let tY=vec 2
	let nX=vec 2; let nY=vec 2
	let temp=vec 2
	FLDI(t0,0); FST(t0,tX); FST(t0,tY); FST(t0,nX); FST(t0,nY)

	test (brushShape eq hBrush) & (splineType eq horSpline)
	ifso [
		FLDI(t0, lineThicknessTable!0); FST(t0, nY)
		FLDI(t0, thickness)
		FLD(t1, xTable); FLD(t2, xTable+2)
		if FCM(t1, t2) eq 1 then FNEG(t0)
		FST(t0, tX)
		]

	ifnot test (brushShape eq vBrush) & (splineType eq verSpline)
	ifso [
		FLDI(t0, lineThicknessTable!0); FST(t0, nX)
		FLDI(t0, thickness)
		FLD(t1, yTable); FLD(t2, yTable+2)
		if FCM(t1, t2) eq 1 then FNEG(t0)
		FST(t0, tY)
		]

	ifnot switchon brushShape into [
	case rBrush:
	case sBrush:
		FLD(t0, xTable+2); FSB(t0, xTable)
		FLD(t1, yTable+2); FSB(t1, yTable)
		FLD(t2,t0); FML(t2,t0)
		FLD(t3,t1); FML(t3,t1)
		FAD(t2,t3); FST(t2,temp); SquareRoot(temp)
		FLDI(t2,thickness); FDV(t2,temp)
		FML(t0, t2);
		if brushShape eq sBrush then FST(t0, tX); FST(t0, nY)
		FML(t1, t2);
		if brushShape eq sBrush then FST(t1, tY); FNEG(t1); FST(t1, nX);
		endcase
	case hBrush:
		FLDI(t0,thickness); FST(t0,nX); endcase
	case vBrush:
		FLDI(t0,thickness); FST(t0,nY); endcase
		]
	let x0, y0, x1, y1, x2, y2, x3, y3=nil, nil, nil, nil, nil, nil, nil, nil
	FLD(t0,xTable); FAD(t0,nX); FSB(t0,tX); x0=FTR(t0)
	FLD(t0,yTable); FAD(t0,nY); FSB(t0,tY); y0=FTR(t0)
	FLD(t0,xTable+2); FAD(t0,nX); FAD(t0,tX); x1=FTR(t0)
	FLD(t0,yTable+2); FAD(t0,nY); FAD(t0,tY); y1=FTR(t0)
	FLD(t0,xTable+2); FSB(t0,nX); FAD(t0,tX); x2=FTR(t0)
	FLD(t0,yTable+2); FSB(t0,nY); FAD(t0,tY); y2=FTR(t0)
	FLD(t0,xTable); FSB(t0,nX); FSB(t0,tX); x3=FTR(t0)
	FLD(t0,yTable); FSB(t0,nY); FSB(t0,tY); y3=FTR(t0)
	resultis brushShape eq rBrush ?
		WriteLinkObject(pressFile, x0, y0, x1, y1, x2, y2, x3, y3),
		WriteStripeObject(pressFile, x0, y0, x1, y1, x2, y2, x3, y3)
	]



and WriteStripeObject(pressFile, x0, y0, x1, y1, x2, y2 , x3, y3) =
valof [WriteStripeObject
	// STRIPE (=paralleloid) OBJECT
	// first, check whether it is a vertical or horizontal rectangle
	if (x0 eq x1) & (x2 eq x3) & (y0 eq y3) & (y1 eq y2) then
		resultis PutRectangleInELtable(
						((x0 ls x2) ? x0, x2),
						((y0 ls y1) ? y0, y1),
						((x0 ls x2) ? (x2-x0+1), (x0-x2+1)),
						((y0 ls y1) ? (y1-y0+1), (y0-y1+1)))
	if (x0 eq x3) & (x1 eq x2) & (y0 eq y1) & (y2 eq y3) then
		resultis PutRectangleInELtable(
						((x0 ls x1) ? x0, x1),
						((y0 ls y2) ? y0, y2),
						((x0 ls x1) ? (x1-x0+1), (x0-x1+1)),
						((y0 ls y2) ? (y2-y0+1), (y0-y2+1)))
	// no, so let's make an object
	let objectWordCount=0
	PutsMove(pressFile, lv objectWordCount, x0, y0)
	PutsLine(pressFile, lv objectWordCount, x1, y1)
	PutsLine(pressFile, lv objectWordCount, x2, y2)
	PutsLine(pressFile, lv objectWordCount, x3, y3)
	PutsLine(pressFile, lv objectWordCount, x0, y0)
	resultis PutObjectInELtable(objectWordCount)
	]WriteStripeObject



and WriteLinkObject(pressFile, x0, y0, x1, y1, x2, y2 , x3, y3) = valof [WriteLinkObject
	// LINK OBJECT (= stripe with rounded tips)
	let objectWordCount=0
	PutsMove(pressFile, lv objectWordCount, x0, y0)
	PutsLine(pressFile, lv objectWordCount, x1, y1)
	PutsRoundTip(pressFile, lv objectWordCount, x1, y1, x2, y2)
	PutsLine(pressFile, lv objectWordCount, x3, y3)
	PutsRoundTip(pressFile, lv objectWordCount, x3, y3, x0, y0)
	resultis PutObjectInELtable(objectWordCount)
	]WriteLinkObject



and GetThickness(splinePointer) =
	lineThicknessTable!(splinePointer>>SPLINE.thickness)



and ScaleKnotTable(xTable, yTable, n, factor, tx, ty) be [
	let fpFactor=vec 2
	FST(FLDI(t0, factor), fpFactor)
	let fpTx=vec 2
	FST(FLDI(t0, tx), fpTx)
	let fpTy=vec 2
	FST(FLDI(t0, ty), fpTy)
	for k=0 to n-1 do [
		let kX=xTable+2*k
		let kY=yTable+2*k
		FST(FML(FSB(FLD(t0, kX), fpTx), fpFactor), kX)
		FST(FML(FSB(FLD(t0, kY), fpTy), fpFactor), kY)
		]
	]



and ComputeNormal(thickness, dX, dY, nX, nY, tX, tY) = valof [
	// compute & store "normalized" & scaled tangent & normal vectors
	// tX ←  dX * t / sqrt(dX↑2 + dY↑2)
	// tY ←  dY * t / sqrt(dX↑2 + dY↑2)
	// nX ← - tY
	// nY ← tX
	FAD(FML(FLD(t1, dX), dX), FML(FLD(t2, dY), dY))
	unless FSN(t1) resultis 0
	let temp=vec 2; FST(t1, temp); SquareRoot(temp)
	FDV(FLDI(t0, thickness), temp)
	FST(FNEG(FST(FML(FLD(t1, dY), t0),  tY)), nX)
	FST(FST(FML(FLD(t1, dX), t0),  tX), nY)
	if showValues then PrintFpValues("ComputeNormal: ", dX, dY, nX, nY, tX, tY)
	resultis true
	]



and MakeCubic(x0, x1, dx0, dx1, a, b) be [
	// a = 2 (x0-x1) + x'0 + x'1
	FLDI(t2, 2)
	FLD(t0, x0); FSB(t0, x1); FML(t0, t2)
	FAD(t0, dx0); FAD(t0, dx1); FST(t0, a)
	// b = 3 (x1-x0) - 2 x'0 - x'1
	FLDI(t3, 3)
	FLD(t0, x1); FSB(t0, x0); FML(t0,  t3)
	FSB(t0, dx1); FSB(t0, dx0); FSB(t0, dx0); FST(t0, b)
	if showValues then PrintFpValues("MakeCubic: ", x0, x1, dx0, dx1, a, b)
	]