// March 31, 1978  10:42 AM			***  overlay A ***


get "zpDefs.bcpl"

// outgoing procedures:

external [
	createSpline
	createCyclicSpline
	redrawSpline
	dashSpline
	addNewKnot
	backUp
	startAgain
	clearSelection
	deleteSelection
	addSplineSelection
	addTextSelection
	selectAll
	prepareTransform
	clearTransform
	copyItem
	transformItem
	]


// incoming procedures:

external [
	MoveBlock		// SYSTEM

	FLDI; FST; FLD; FML	// FLOAT
	FAD; FDV; FSB; FNEG
	FTR; FSN

	giveUp			// ZPUTIL
	typeForm

	makeSpline		// ZPMAKE
	computeSpline
	splineType
	newSplineID

	obtainBlock		// ZPBLOCK
	putBlock

	curve			// ZPDRAW
	drawSpline
	markSpline
	checkSplineID
	XORdot
	giveMeXY

	showText		// ZPTEXT
	eraseText
	markText
	checkTextID
	newTextID

	DTTitems		// ZPITEM		(same overlay)
	addItemTable
	countItemTable
	checkItemID
	showItem
	eraseItem
	markItem
	flushItem
	]


// incoming statics:

external [
	@splineTable		// ZPINIT
	@textTable
	@selectionTable
	@maxSplineID
	@maxTextID
	@maxKnots
	@newSplineXYtable
	@transformXYtable
	@bitmap00
	@scanlineWidth
	@Xmax
	@Ymax
	@brush
	@color

	brushFont		// ZPFONT

	@currentTextId		// ZPEDIT
	]



//****************************************************************
// Spline operations: create / redraw / dash
//****************************************************************

let createSpline() = valof [createSpline
	let n=clearXYtable(newSplineXYtable)
	unless n resultis 0
	let xTable=obtainBlock(4*n)
	unless xTable resultis giveUp("[createSpline]")
	let yTable=xTable+2*n
	makeKnotTable(xTable, yTable, n)
	let id=makeSpline(n, xTable, yTable, brush, color)
	putBlock(xTable)
	resultis id
	]createSpline



and createCyclicSpline() = valof [createCyclicSpline
	if newSplineXYtable>>XYTABLE.n le 2 resultis createSpline()
	// one more knot (to close the curve)
	let n=clearXYtable(newSplineXYtable)+1
	let xTable=obtainBlock(4*n)
	unless xTable resultis giveUp("[createCyclicSpline]")
	let yTable=xTable+2*n
	makeKnotTable(xTable, yTable, n-1)
	//close the curve (knot n = knot 1)
	FST(FLD(0, xTable), xTable+2*(n-1))
	FST(FLD(0, yTable), yTable+2*(n-1))
	let id=makeSpline(n, xTable, yTable, brush, color, periodicSpline)
	putBlock(xTable)
	resultis id
	]createCyclicSpline



and addNewKnot(x, y) be [addNewKnot
	test newSplineXYtable>>XYTABLE.n+1 le maxKnots
	ifso putXYtable(newSplineXYtable, x, y)
	ifnot typeForm(0, "Sorry, no more than ", 10, maxKnots, 0, " knots!*N", 
		0, "To allow more knots, start DRAW with switch /K (e.g.: DRAW ",
		10, 2*maxKnots, 0, "/K )*N")
	]addNewKnot



and redrawSpline(id) be [redrawSpline
	let splinePointer=checkSplineID(id)
	unless splinePointer return
	if splinePointer>>SPLINE.drawBrush eq brush<<BRUSH.drawBrush return
	curve(splinePointer, eraseMode)
	splinePointer>>SPLINE.drawBrush=brush<<BRUSH.drawBrush
	curve(splinePointer, drawMode)
	]redrawSpline



and dashSpline(id) be [dashSpline
	let splinePointer=checkSplineID(id)
	unless splinePointer return
	curve(splinePointer, eraseMode)
	splinePointer>>SPLINE.dashed=splinePointer>>SPLINE.dashed ? 0, 1
	curve(splinePointer, drawMode)
	]dashSpline



//****************************************************************
// Transform operation
//****************************************************************



and prepareTransform(x, y) be [prepareTransform
	let n=putXYtable(transformXYtable, x, y)
	let npoints=transformXYtable>>XYTABLE.npoints
	if n eq npoints then [
		clearTransform()
		let ns=countItemTable(selectionTable)
		let q0=lv(transformXYtable>>XYTABLE.xy0)
		let doTransform=transformXYtable>>XYTABLE.transf
		test checkTransform(q0, npoints)
		ifso test transformXYtable>>XYTABLE.copy
			// copy
			ifso for s=1 to ns do [
				let oldItemID=selectionTable!s
				let newItemID=copyItem(oldItemID, doTransform)
				unless newItemID loop
				markItem(oldItemID, 0)
				selectionTable!s=newItemID
				transformItem(newItemID, q0, npoints)
				unless doTransform then showItem(newItemID)
				]
			// move
			ifnot DTTitems(selectionTable, q0, npoints)
		ifnot typeForm(0, "*NIllegal transform parameters*N")
		]
	]prepareTransform


and checkTransform(q0, npoints) = selecton npoints into [
		case 2: (q0>>XY.x ne (q0+2)>>XY.x) % (q0>>XY.y ne (q0+2)>>XY.y);
		case 4: set4pointTransform(q0);
		case 6: set6pointTransform(q0)
		]



and clearTransform() be [clearTransform
	clearXYtable(transformXYtable)
	]clearTransform



//****************************************************************
// Item operations: move - copy / translate - transform
//****************************************************************



and copyItem(itemID, noChain) = valof [copyItem
	// noChain is a boolean
	let newID, newItemID, pointerTable, blockSize=nil, nil, nil, nil
	let itemPointer=checkItemID(itemID)
	unless itemPointer resultis 0
	test itemID<<itemID.tFlag
	ifso [
		newID=newTextID()
		unless newID resultis 0
		newItemID=textFlag + newID
		pointerTable=textTable
		blockSize=TEXTblockSize +
			((itemPointer+TEXTblockSize)>>STRING.length)/2 + 1
		]
	ifnot [
		newID=newSplineID()
		unless newID resultis 0
		newItemID=newID
		pointerTable=splineTable
		blockSize=SPLINEknotBase + 4*(itemPointer>>SPLINE.nKnots)
		]
	let newItemPointer=obtainBlock(blockSize)
	unless newItemPointer resultis giveUp("[CopyItem-1]")
	MoveBlock(newItemPointer, itemPointer, blockSize)

	unless itemID<<itemID.tFlag then [
		let newChainPointer=0
		unless noChain then [
			let chainPointer=itemPointer>>SPLINE.chain
			if chainPointer then [
				let chainSize=(itemPointer>>SPLINE.nBeads)*(BEADsize+2)
				let chainBlockSize=chainSize + chainPointer!(chainSize-1)
				newChainPointer=obtainBlock(chainBlockSize)
				unless newChainPointer resultis
					giveUp("[copyItem-2]", newItemPointer)
				MoveBlock(newChainPointer, chainPointer, chainBlockSize)
				]
			]
		newItemPointer>>SPLINE.chain=newChainPointer
		]

	pointerTable!newID=newItemPointer
	pointerTable!0=pointerTable!0 + 1
	resultis newItemID
	]copyItem



and transformItem(itemID, q0, npoints) = valof [transformItem
	// 2-point (translate), 4-point or 6-point transform
	// q0 is the base of a 2, 4 or 6 point vector (length 2*npoints)

	let itemPointer=checkItemID(itemID)
	unless itemPointer resultis 0

	if npoints eq 2 then [
		// 2-point transform = translation
		let p0=q0+2
		let deltax=p0>>XY.x-q0>>XY.x
		let deltay=p0>>XY.y-q0>>XY.y
		test itemID<<itemID.tFlag
		ifso [
			itemPointer>>TEXT.left=itemPointer>>TEXT.left + deltax
			itemPointer>>TEXT.top=itemPointer>>TEXT.top + deltay
			]
		ifnot [
			// translate knots
			let xTable=itemPointer+SPLINEknotBase
			let n=itemPointer>>SPLINE.nKnots
			translateKnotTable(xTable, xTable+2*n, n, deltax, deltay)
			// translate special points
			let knotPointer=itemPointer+SPLINEheaderSize
			for k=1 to SPLINExyPairs do [
				knotPointer>>XY.x=knotPointer>>XY.x + deltax
				knotPointer>>XY.y=knotPointer>>XY.y + deltay
				knotPointer=knotPointer+2
				]
			]
		resultis true
		]

	// 4-point & 6-point transform
	unless (selecton npoints into [
		case 4: set4pointTransform(q0);
		case 6: set6pointTransform(q0) ]) resultis 0

	let p0=q0+npoints
	test itemID<<itemID.tFlag
	ifso [
		// transform text
		transform1point(lv itemPointer>>TEXT.left,
				lv itemPointer>>TEXT.top, q0, p0)
		showItem(itemID)
		]
	ifnot [
		// transform spline
		let n=itemPointer>>SPLINE.nKnots
		let chainPointer=itemPointer>>SPLINE.chain
		if chainPointer then [
			putBlock(chainPointer)
			itemPointer>>SPLINE.chain=0
			]
		let xTable=itemPointer+SPLINEknotBase
		transformKnotTable(xTable, xTable+2*n, n, q0, p0)
		splineType(itemPointer)
		transform1point(lv itemPointer>>SPLINE.xSelect,
				lv itemPointer>>SPLINE.ySelect, q0, p0)
		transform1point(lv itemPointer>>SPLINE.xColor,
				lv itemPointer>>SPLINE.yColor, q0, p0)
		computeSpline(itemPointer)
		]
	resultis true
	]transformItem



//****************************************************************
// Knot table operations
//****************************************************************


and makeKnotTable(xTable, yTable, n) be [makeKnotTable
	let knotPointer=lv(newSplineXYtable>>XYTABLE.xy0)
	for k=0 to n-1 do [
		FST(FLDI(0, knotPointer>>XY.x), xTable+2*k)
		FST(FLDI(0, knotPointer>>XY.y), yTable+2*k)
		knotPointer=knotPointer+2
		]
	]makeKnotTable



and translateKnotTable(xTable, yTable, n, deltax, deltay) be [translateKnotTable
	// xTable & yTable: floating point
	// deltax & deltay: integer
	// CAUTION: uses register 0
	for k=0 to n-1 do [
		FST(FAD(FLDI(0, deltax), xTable+2*k), xTable+2*k)
		FST(FAD(FLDI(0, deltay), yTable+2*k), yTable+2*k)
		]
	]translateKnotTable



and sumProduct(r, a, b, c, d) be [sumProduct
	// r, a, b, c & d are floating point registers
	// compute r = a*b + c*d
	// CAUTION: uses register 0
	manifest t=0
	FAD(FML(FLD(r, a), b), FML(FLD(t, c), d))
	]sumProduct



and diffProduct(r, a, b, c, d) be [diffProduct
	// r, a, b, c & d are floating point registers
	// compute r = a*b - c*d
	// CAUTION: uses register 0
	manifest t=0
	FSB(FML(FLD(r, a), b), FML(FLD(t, c), d))
	]diffProduct



and transformKnotTable(xTable, yTable, n, q0, p0) be [transformKnotTable
	// xTable & yTable: floating point
	// performs matrix computation
	// CAUTION:
	// 	coefficients are expected in registers a, b, c, d & delta
	// 	uses registers 0 through 6

	manifest [
		// coefficients for transformation
		a=20; b=21; c=22; d=23; delta=24
		// registers for computation
		t=0
		fpx0=1; fpy0=2;
		x=3; y=4; nx=5; ny=6
		]

	let x0=p0>>XY.x; FLDI(fpx0, x0)
	let y0=p0>>XY.y; FLDI(fpy0, y0)
	translateKnotTable(xTable, yTable, n, x0-q0>>XY.x, y0-q0>>XY.y)

	for k=0 to n-1 do [
		FSB(FLD(x, xTable+2*k), fpx0)
		FSB(FLD(y, yTable+2*k), fpy0)
		// X ← (a x + b y)/delta
		sumProduct(nx, a, x, b, y)
		FST(FAD(FDV(nx, delta), fpx0), xTable+2*k)
		// Y ← (c x + d y)/delta
		sumProduct(ny, c, x, d, y)
		FST(FAD(FDV(ny, delta), fpy0), yTable+2*k)
		]
	]transformKnotTable



and transform1point(lvX, lvY, q0, p0) be [transform1point
	let x=vec 2
	let y=vec 2
	FST(FLDI(0, @lvX), x)
	FST(FLDI(0, @lvY), y)
	transformKnotTable(x, y, 1, q0, p0)
	@lvX=FTR(FLD(0, x))
	@lvY=FTR(FLD(0, y))
	]transform1point



and set4pointTransform(q0) = valof [set4pointTransform
	let q1, p0, p1=q0+2, q0+4, q0+6
	// 4-point transformation mapping q0 & q1 onto p0 & p1
	// general translation/rotation/scaling transformation

	manifest [
		// coefficients of transformation 
		// CAUTION: these registers should be the same as those
		//  used by transformKnotTable
		a=20; b=21; c=22; d=23; delta=24
		// for computing of coefficients
		x1=1; y1=2; x2=3; y2=4
		]

	FLDI(x1, q1>>XY.x-q0>>XY.x); FLDI(y1, q1>>XY.y-q0>>XY.y)
	FLDI(x2, p1>>XY.x-p0>>XY.x); FLDI(y2, p1>>XY.y-p0>>XY.y)
	// delta= x1*x1 + y1*y1
	sumProduct(delta, x1, x1, y1, y1)
	// points q0 & q1 should be DISTINCT
	unless FSN(delta) resultis 0
	// a= x1*x2 + y1*y2
	sumProduct(a, x1, x2, y1, y2)
	// d=a
	FLD(d, a)
	// c= x1*y2 - y1*x2
	diffProduct(c, x1, y2, y1, x2)
	// b=-c
	FNEG(FLD(b, c))
	resultis true
	]set4pointTransform



and set6pointTransform(q0) = valof [set6pointTransform
	let q1, q2, p0, p1, p2=q0+2, q0+4, q0+6, q0+8, q0+10
	// general 6 point transformation mapping q0, q1, q2 onto p0, p1, p2
	// general linear transformation

	manifest [
		// coefficients of transformation
		// CAUTION: these registers should be the same as those
		//  used by transformKnotTable
		a=20; b=21; c=22; d=23; delta=24
		// points q1, q2, p1, p2 for computing coefficients
		xp1=10; xp2=11; xq1=12; xq2=13
		yp1=14; yp2=15; yq1=16; yq2=17
		]

	let x0=p0>>XY.x
	let y0=p0>>XY.y
	let z0=q0>>XY.x
	let w0=q0>>XY.y
	// compute coefficients
	FLDI(xp1, p1>>XY.x-x0); FLDI(yp1, p1>>XY.y-y0)
	FLDI(xp2, p2>>XY.x-x0); FLDI(yp2, p2>>XY.y-y0)
	FLDI(xq1, q1>>XY.x-z0); FLDI(yq1, q1>>XY.y-w0)
	FLDI(xq2, q2>>XY.x-z0); FLDI(yq2, q2>>XY.y-w0)
	// delta=xq1*yq2-xq2*yq1
	diffProduct(delta, xq1, yq2, xq2, yq1)
	// points q0, q1 & q2 SHOULD NOT BE COLINEAR
	unless FSN(delta) resultis 0
	// a=xp1*yq2-xp2*yq1
	diffProduct(a, xp1, yq2, xp2, yq1)
	// b=xq1*xp2-xq2*xp1
	diffProduct(b, xq1, xp2, xq2, xp1)
	// c=yp1*yq2-yp2*yq1
	diffProduct(c, yp1, yq2, yp2, yq1)
	// d=xq1*yp2-xq2*yp1
	diffProduct(d, xq1, yp2, xq2, yp1)
	resultis true
	]set6pointTransform


//****************************************************************
// selection operations
//****************************************************************


and selectAll() be [selectAll
	for id=1 to maxSplineID do addSplineSelection(id)
	for id=1 to maxTextID do addTextSelection(id)
	]selectAll


and clearSelection() be [clearSelection
	let ns=countItemTable(selectionTable)
	for i=1 to ns do markItem(selectionTable!i, 0)
	selectionTable!0=0
	]clearSelection


and deleteSelection() be [deleteSelection
	DTTitems(selectionTable)
	selectionTable!0=0
	]deleteSelection


and addSplineSelection(id, h; numargs n) be [addSplineSelection
	let x=h>>HITPOINT.x		// might be garbage!
	let y=h>>HITPOINT.y
	let splinePointer=checkSplineID(id)
	unless splinePointer return
	if addItemTable(selectionTable, id) then [
		if n ne 2 then giveMeXY(splinePointer, lv x, lv y)
		splinePointer>>SPLINE.xSelect=x
		splinePointer>>SPLINE.ySelect=y
		markSpline(id, 1)
		]
	]addSplineSelection


and addTextSelection(id) be [addTextSelection
	unless checkTextID(id) return
	if addItemTable(selectionTable, textFlag+id) then markText(id, 1)
	]addTextSelection




//****************************************************************
// operations on XY tables
//****************************************************************


and putXYtable(xyTable, x, y) = valof [putXYtable
	let n=xyTable>>XYTABLE.n
	let xyPointer=lv(xyTable>>XYTABLE.xy0)+2*n
	xyPointer>>XY.x=x
	xyPointer>>XY.y=y
	knotSymbol(x, y)
	xyTable>>XYTABLE.n=n+1
	resultis n+1
	]putXYtable



and removeXYtable(xyTable) be [removeXYtable
	let n=xyTable>>XYTABLE.n-1
	unless n ge 0 return
	let xyPointer=lv(xyTable>>XYTABLE.xy0)+2*n
	knotSymbol(xyPointer>>XY.x, xyPointer>>XY.y)
	xyTable>>XYTABLE.n=n
	]removeXYtable



and clearXYtable(xyTable) = valof [clearXYtable
	let n=xyTable>>XYTABLE.n
	unless n gr 0 resultis 0
	let xyPointer=lv(xyTable>>XYTABLE.xy0)
	for k=1 to n do [
		knotSymbol(xyPointer>>XY.x, xyPointer>>XY.y)
		xyPointer=xyPointer+2
		]
	xyTable>>XYTABLE.n=0
	resultis n
	]clearXYtable



and knotSymbol(x0, y0) be [knotSymbol
	for x=x0-4 to x0+4 do XORdot(x, y0)
	for y=y0-4 to y0+4 do XORdot(x0, y)
	]knotSymbol



//****************************************************************
// startAgain/back up (XY tables)
//****************************************************************

and startAgain() be [startAgain
	test currentTextId
	ifso [
		eraseText(currentTextId)
		flushItem(currentTextId + textFlag)
		]
	ifnot [
		clearXYtable(newSplineXYtable)
		clearTransform()
		]
	]startAgain



and backUp() be [backUp
	test currentTextId
	ifso [
		eraseText(currentTextId)
		flushItem(currentTextId + textFlag)
		]
	ifnot [
		removeXYtable(newSplineXYtable)
		removeXYtable(transformXYtable)
		]
	]backUp