// May 1, 1978  2:37 PM				*** OVERLAY D ***

get "zpDefs.bcpl"

get "zpComDf.bcpl"


// outgoing procedures

external [
	drawFreeHand
	getEventFreeHand
	freeHandCursor
	]

// outgoing statics

external [
	@sampleBuffer
	@maxSampleCount
	]

static [
	@sampleBuffer
	@maxSampleCount
	]


// incoming procedures:

external [
	MoveBlock		// SYSTEM
	Zero
	Gets
	Endofs

	FLDI; FST		// FLOAT
	FTR; FAD; FML; FDV

	giveUp			// ZPUTIL
	typeForm

	grid			// ZPEDIT

	curveHitDetect		// ZPINTER

	makeSpline		// ZPMAKE

	erase			// ZPDRAW
	draw
	initBitBlt
	XORdot

	obtainBlock		// ZPBLOCK
	putBlock

	paintDot		// ZPCONVERT
	]


// incoming statics:

external [
	@Xmax			// ZPINIT
	@Ymax
	@Xref0
	@Yref0
	@textWidth
	@textHeight
	@scanlineWidth
	@bitmap00
	@brush
	@color
	@maxKnots
	@newSplineXYtable

	brushFont		// ZPCONVERT

	@Xref			// ZPINTER
	@Yref

	keys			// SYSTEM
	]


// local statics:

static [
	@sampleBufferLength
	// various parameters for line & spline fitting:
	@areaMax=200
	@areaMin=40
	@showFit=false
	@averagingSpan=8
	@checkLineCount=4
	@checkLineRatio=4
	@curvatureSpan=32
	@computeCurvature=0
	@curvatureScale=256
	]


// local definitions:



//*****************************************************************


let getEventFreeHand(h) = valof [getEventFreeHand
	// h is a HITPOINT vector
	// return an EVENT word (i.e.: switch code | event code)
	structure SWITCH [
		blank	bit 13
		sw1	bit  1
		sw3	bit  1
		sw2	bit  1
		]

	manifest [
		mouseX= #424
		mouseY= #425
		mouseSW= #177030
		]

	let XrefOffset, YrefOffset=0,0
	let brushPt=brushFont + brush
	initBitBlt(brushPt + brushPt!0, drawMode)
	[ // keyboard ? => result= 0 | char code
	  unless Endofs(keys) resultis Gets(keys)

	  // mouse switches ?
	  let x1,y1,x2,y2=nil,nil,nil,nil
	  //wait till some switch is on
	  let s1=(@mouseSW & 7) xor 7
	  unless s1 loop
	  x1=@mouseX-Xref
	  y1=Yref-@mouseY

	  // then check first point:
	  // outside display area ?
	  if (x1 gr Xmax) % (y1 gr Ymax) % (x1 ls 0) % (y1 ls 0)  then [
		while ((@mouseSW & 7) xor 7) ne 0 do [ let t=nil ]
		// outside menu area ? => try again
		if (x1 gr Xmax) % (y1 gr Ymax) loop
		// menu & text buffer area ? => result= 0 | menu code
		if (y1 ls 0) then
		test (x1 ge 0) & (x1 le textWidth) & ((y1+16+textHeight) ge 0)
			// text buffer area
			ifso resultis (menuCode + (2*symbolCount + 1))
			ifnot loop
		if (x1 ls 0) then [
			// menu code is a menu number + menuCode
			// ( 0 < menu number < 2*symbolCount+1 )
			let r=(Ymax-y1)/symbolHeight+1
			unless r ge 1 & r le symbolCount loop
			resultis (selecton ((-x1)/symbolHeight) into [
				case 0: r; case 1: r+symbolCount; default: 0 ]) + menuCode
			]
		]

	  // display area ? => save & draw the sample points, result= 1 | 0
	  if (s1<<SWITCH.sw3) then [
			let gx=grid(x1)
			let gy=grid(y1)
			XrefOffset=gx-x1
			YrefOffset=gy-y1
			x1=gx
			y1=gy
			Xref=Xref-XrefOffset
			Yref=Yref+YrefOffset
			]
	  sampleBuffer!0=x1
	  sampleBuffer!1=y1
	  draw(x1, y1)
	  sampleBufferLength=2
	  x2=x1
	  y2=y1
	  //wait till all switches are off
	  [ let s2=(@mouseSW & 7) xor 7
	    unless s2 break
	    let x=@mouseX-Xref
	    let y=Yref-@mouseY
	    let dx= (x gr x2) ? x-x2, x2-x
	    let dy= (y gr y2) ? y-y2, y2-y
	    if ((dx gr 1) % (dy gr 1)) & (sampleBufferLength ls maxSampleCount) then [
			sampleBuffer!sampleBufferLength=x
			sampleBuffer!(sampleBufferLength+1)=y
			sampleBufferLength=sampleBufferLength+2
			draw(x,y)
			x2=x; y2=y
			]
	    ] repeat
	  if (s1<<SWITCH.sw3) then [
			let x=sampleBuffer!(sampleBufferLength-2)
			let y=sampleBuffer!(sampleBufferLength-1)
			x=grid(x)
			y=grid(y)
			sampleBuffer!(sampleBufferLength-2)=x
			sampleBuffer!(sampleBufferLength-1)=y
			draw(x,y)
			]
	  Xref=Xref+XrefOffset
	  Yref=Yref-YrefOffset
	  resultis (1 lshift 8)

	  ] repeat
	]getEventFreeHand


and drawFreeHand() = valof [drawFreeHand
	let sampleCount=sampleBufferLength/2
	// select knots; erase sample points
	let brushPt=brushFont + brush
	initBitBlt(brushPt + brushPt!0, eraseMode)
	let knotTable=lv(newSplineXYtable>>XYTABLE.xy0)
	let area, a1, a2, posA1A2= 0,0,areaMax,areaMax
	// smoothing by "cumulative" running average
	let avrgSpan=2*averagingSpan
	if averagingSpan ne 0 then [
		unless showFit for i=0 to avrgSpan-2 by 2 do
			erase(sampleBuffer!i, sampleBuffer!(i+1))
		for i=avrgSpan to sampleBufferLength-avrgSpan-2 by 2 do [
			unless showFit then erase(sampleBuffer!i, sampleBuffer!(i+1))
			sampleBuffer!i=
				(sampleBuffer!(i-avrgSpan)+sampleBuffer!(i+avrgSpan))/2
			sampleBuffer!(i+1)=
				(sampleBuffer!(i+1-avrgSpan)+sampleBuffer!(i+1+avrgSpan))/2
			]
		unless showFit then
		for i=sampleBufferLength-avrgSpan to sampleBufferLength-2 by 2 do
			erase(sampleBuffer!i, sampleBuffer!(i+1))
		]

	// experiment with curvature
	initBitBlt(brushPt + brushPt!0, drawMode)
	let curvSpan=2*curvatureSpan
	if computeCurvature ne 0 then [
		let cOffset=vec 2
		let cScaling=vec 2
		FML(FLDI(0, curvatureSpan), FLDI(1, curvatureSpan))
		FST(FAD(0, 0), cOffset)
		FST(FDV(FLDI(0, curvatureScale/2), cOffset), cScaling)
		for i=curvSpan to sampleBufferLength-curvSpan-2 by 2 do [
			let x1=sampleBuffer!i - sampleBuffer!(i-curvSpan)
			let x2=sampleBuffer!(i+curvSpan) - sampleBuffer!i
			let y1=sampleBuffer!(i+1) - sampleBuffer!(i+1-curvSpan)
			let y2=sampleBuffer!(i+1+curvSpan) - sampleBuffer!(i+1)
			test computeCurvature eq 1
				ifso FLDI(0, x1*x2 + y1*y2)
				ifnot FLDI(0, x1*y2 - x2*y1)
			FML(FAD(0, cOffset), cScaling)
			draw((i-curvSpan)/2, FTR(0))
			]
		]

	// first knot
	let kx=sampleBuffer!0
	let ky=sampleBuffer!1
	knotTable!0=kx
	knotTable!1=ky
	XORknot(kx, ky)

	// is it a straight line ???
	let notAline=false
	let lx=sampleBuffer!(sampleBufferLength-2)
	let ly=sampleBuffer!(sampleBufferLength-1)
	let halfCount=sampleCount
	for i=1 to checkLineCount do [
		let midx=(kx+lx)/2
		let midy=(ky+ly)/2
		halfCount=(halfCount+1)/2
		let lineTolerance=distance(kx, ky, lx, ly) rshift checkLineRatio
		lx=sampleBuffer!(2*(halfCount-1))
		ly=sampleBuffer!(2*(halfCount-1)+1)
		if distance(midx, midy, lx, ly) gr lineTolerance
			then [ notAline=true; break ]
		]

	// last knot:
	let knotCount=1
	let nx=notAline ? sampleBuffer!2, sampleBuffer!(sampleBufferLength-2)
	let ny=notAline ? sampleBuffer!3, sampleBuffer!(sampleBufferLength-1)

	// if not a line, select knots for spline fit:
	let distMax=500
	if notAline then for i=4 to sampleBufferLength-2 by 2 do [
		let x0=nx
		let y0=ny
		nx=sampleBuffer!i
		ny=sampleBuffer!(i+1)
		let a0=(x0-kx)*(ny-ky) - (y0-ky)*(nx-kx)
		area=area + a0
		let dist=distance(x0, y0, kx, ky)
		let posArea= area gr 0 ? area, -area
		test (posArea gr areaMax)
			% (dist gr distMax)
			% ((posArea gr areaMin) & ((a0 gr 0 ? a0, -a0) gr posA1A2))
		ifso [
			// new knot
			area=0; a1=0; a2=areaMax; posA1A2=areaMax
			knotTable!(2*knotCount)=x0
			knotTable!(2*knotCount+1)=y0
			distMax=2*dist
			kx=x0; ky=y0
			XORknot(kx, ky)
			knotCount=knotCount+1
			if knotCount eq (maxKnots-1) break
			]
		ifnot [
			a2=a1; a1=a0
			posA1A2=a1+a2
			posA1A2=posA1A2 gr 0 ? posA1A2, -posA1A2
			]
		]

	// last knot
	if sampleCount gr 1 then [
		knotTable!(2*knotCount)=nx
		knotTable!(2*knotCount+1)=ny
		knotCount=knotCount+1
		XORknot(nx, ny)
		]

	// make new spline
	let xTable=obtainBlock(4*knotCount)
	unless xTable resultis giveUp("[drawFreeHand]")
	let yTable=xTable+2*knotCount
	for k=0 to knotCount-1 do [
		FLDI(0, knotTable!(2*k)); FST(0, xTable+2*k)
		FLDI(0, knotTable!(2*k+1)); FST(0, yTable+2*k)
		unless showFit then 
			XORknot(knotTable!(2*k), knotTable!(2*k+1))
		]
	let id=makeSpline(knotCount, xTable, yTable, brush, color)
	sampleBufferLength=0
	putBlock(xTable)
	resultis id
	]drawFreeHand


and freeHandCursor() be [freeHandCursor
	let saveScanlineWidth=scanlineWidth
	Zero(lvAltoCursor, 16)
	scanlineWidth=1
	paintDot(lvAltoCursor+8-YdotOffset, 8-XdotOffset, brushFont+brush)
	scanlineWidth=saveScanlineWidth
	Xref=Xref0 - 8
	Yref=Yref0 - 8
	]freeHandCursor


and distance(x1, y1, x2, y2) = valof [distance
	let dx= x1 gr x2 ? x1-x2, x2-x1
	let dy= y1 gr y2 ? y1-y2, y2-y1
	resultis ((dx gr dy) ? (dx+dy/2), (dy+dx/2))
	]distance


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