// October 10, 1979  10:10 AM by Taft			*** resident ***
//Edited by Lyle Ramshaw September 3, 1980  12:49 PM:
// Hacking on text string positioning
 
get "ZPDEFS.bcpl"

get "ZPCOMDF.bcpl"


// outgoing procedures

external [
	changeCursor
	makeTextCursor
	curveHitDetect
	textHitDetect
	getEventRegular
	]


// outgoing statics

external [
	@Xref
	@Yref
	]

static [
	@Xref
	@Yref
	]


// incoming procedures:

external [
	MoveBlock		// SYSTEM
	Zero
	Endofs
	Gets

	beadHit			// ZPDRAW

	FLD; FTR		// FLOAT
	]


// incoming statics:

external [
	@splineTable		// ZPINIT
	@textTable
	@scanlineWidth
	@textHeight
	@textWidth
	@textBitmap
	@maxSplineID
	@maxTextID
	@Xmax
	@Ymax
	@Xref0
	@Yref0

	cursorTable		// ZPFONT

	keys			// SYSTEM

	@posTextMode		// ZPEDIT
	]


// local statics:

// local definitions:


//*****************************************************************
// cursors
//*****************************************************************

let changeCursor(n) be [changecursor
	MoveBlock(lvAltoCursor, cursorTable+cursorTable!n, 16)
	let deltaX=table [ 0; 8; 8; 8; 8; 8; 8; 8; 8; 8; 8; 8; 8; 8 ]
	let deltaY=table [ 0; 8; 8; 8; 8; 8; 8; 0; 0; 0; 0; 0; 0; 9 ]
	Xref=Xref0 - deltaX!n
	Yref=Yref0 - deltaY!n
	]changecursor


and makeTextCursor() be [makeTextCursor
	Zero(lvAltoCursor, 16)
	let cMode,r,l,p=0,0,0,-1
	let w0,x0,y0=0,0,textHeight/2
	switchon posTextMode into [
	case posTextCenter:
	case posTextTop:
	case posTextBottom:
		r=8-(((textWidth+1)/2) rem 16)
		cMode=1
		if r ls 0 then [ cMode=2; r=-r ]
		l=16-r
		w0=(textWidth+1)/32
		x0=8
		if posTextMode eq posTextBottom then
			y0=textHeight
		if posTextMode eq posTextTop then
			y0=0
		endcase
	case posTextLeft:
		endcase
	case posTextRight:
		l=textWidth rem 16
		cMode=1
		r=16-l
		w0=textWidth/16
		x0=16
		endcase
	]
	if textWidth ls 16 then [
		cMode=0
		p=-1 lshift (16-textWidth)
		x0=(textWidth+1)/2
		if posTextMode eq posTextLeft then x0=0
		if posTextMode eq posTextRight then x0=textWidth
		]
	let n,h=textHeight,0
	if textHeight gr 16 then [
		h=(textHeight/2)-8
		n=16
		]
	let w=textBitmap+h*scanlineWidth+w0
	for c=lvAltoCursor to lvAltoCursor+n do [
		@c=selecton cMode into [
		case 0: @w xor p;
		case 1:((@w rshift r) % (@(w-1) lshift l)) xor -1;
		case 2:((@w lshift r) % (@(w+1) rshift l)) xor -1
			]
		w=w+scanlineWidth
		]
	Xref=Xref0+1-x0
	Yref=Yref0-y0+h-2
	for i=0 to 15 do if lvAltoCursor!i ne 0 return
	changeCursor(textCursor)
	]makeTextCursor



//*****************************************************************
// hit detection
//*****************************************************************


and curveHitDetect(h) = valof [curveHitDetect
	// h is a HITPOINT vector
	//return ID of closest curve or 0
	let x,y=h>>HITPOINT.x,h>>HITPOINT.y
	manifest [ beadRange=35; hitRange=8 ]
	let hb=vec HITPOINTblockSize
	let hitd,hitID,hitx,hity=hitRange+1,0,nil,nil
	//scan through existing splines
	for id=1 to maxSplineID do [
		let splinePointer=splineTable!id
		unless splinePointer then loop
		let xb=splinePointer>>SPLINE.xStart
		let yb=splinePointer>>SPLINE.yStart
		let dx=(x gr xb) ? (x-xb), (xb-x)
		let dy=(y gr yb) ? (y-yb), (yb-y)
		let d0=(dx gr dy) ? dx+(dy rshift 1), dy+(dx rshift 1)
		switchon splinePointer>>SPLINE.type into [
		case regSpline:
			[
			let nBeads=splinePointer>>SPLINE.nBeads
			let beadPointer=splinePointer>>SPLINE.chain+nBeads*BEADsize
			for b=1 to nBeads do [
				let newxb,newyb=nil,nil
				test beadPointer>>BEADXY.xDir
				ifso newxb=xb+beadPointer>>BEADXY.deltaX
				ifnot newxb=xb-beadPointer>>BEADXY.deltaX
				test beadPointer>>BEADXY.yDir
				ifso newyb=yb+beadPointer>>BEADXY.deltaY
				ifnot newyb=yb-beadPointer>>BEADXY.deltaY
				let cx=(xb+newxb) rshift 1
				let cy=(yb+newyb) rshift 1
				if (((x gr cx) ? (x-cx), (cx-x)) le beadRange)
				 & (((y gr cy) ? (y-cy), (cy-y)) le beadRange) then [
					let d=beadHit(splinePointer,b,xb,yb,x,y,hb)
					if d ls hitd then [
						hitd=d; hitID=id
						hitx=hb>>HITPOINT.x; hity=hb>>HITPOINT.y
						]
					]
				beadPointer=beadPointer+2
				xb,yb=newxb,newyb
				]
			endcase
			]
		case dotSpline:
			// point
			if d0 ls hitd then [ hitd=d0; hitID=id; hitx=xb; hity=yb ]
			endcase
		case horSpline:
			// horizontal line
			[
			let x1=splinePointer>>SPLINE.left
			let x2=splinePointer>>SPLINE.right
			if (dy ls hitd) & (x gr (x1-hitd)) & (x ls (x2+hitd)) then [
				hitd=dy; hitID=id; hity=yb
				hitx= (x gr x1) ? ((x ls x2) ? x, x2), x1
				]
			endcase
			]
		case verSpline:
			// vertical line
			[
			let y1=splinePointer>>SPLINE.bottom
			let y2=splinePointer>>SPLINE.top
			if (dx ls hitd) & (y gr (y1-hitd)) & (y ls (y2+hitd)) then [
				hitd=dx; hitID=id; hitx=xb
				hity= (y gr y1) ? ((y ls y2) ? y, y2), y1
				]
			endcase
			]
		]
		]
	h>>HITPOINT.id=hitID
	h>>HITPOINT.x=hitx
	h>>HITPOINT.y=hity
	resultis hitID
	]curveHitDetect



and textHitDetect(h) = valof [textHitDetect
	// h is a HITPOINT vector
	let x,y=h>>HITPOINT.x,h>>HITPOINT.y
	h>>HITPOINT.id=0
	for t=1 to maxTextID do [
		let textPointer=textTable!t
		unless textPointer loop
		if (x ge textPointer>>TEXT.left)
		 & (x le textPointer>>TEXT.right)
		 & (y le textPointer>>TEXT.top)
		 & (y ge textPointer>>TEXT.bottom) then [
			h>>HITPOINT.x=(textPointer>>TEXT.left+textPointer>>TEXT.right)/2
			h>>HITPOINT.y=(textPointer>>TEXT.top+textPointer>>TEXT.bottom)/2
			h>>HITPOINT.id=t
			break
			]
		]
	resultis h>>HITPOINT.id
	]textHitDetect



//*****************************************************************
// event input
//*****************************************************************


and getEventRegular(h) = valof [getEventRegular
	// 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
		]

	[ // first, keyboard
	  // result= 0 | char code
	  unless Endofs(keys) resultis Gets(keys)

	  // second, keyset (to be implemented)

	  // third, 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
	  //wait till all switches are off
	  [ let s2=(@mouseSW & 7) xor 7
	    if s2 loop
	    x2=@mouseX-Xref
	    y2=Yref-@mouseY
	    break
	    ] repeat

	  // outside display or menu area ?
	  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 : 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
	  // result= switch code | 0
	  h>>HITPOINT.x1=x1
	  h>>HITPOINT.y1=y1
	  h>>HITPOINT.x2=x2
	  h>>HITPOINT.y2=y2
	  let switchCode= s1<<SWITCH.sw1 ? 1, (s1<<SWITCH.sw2 ? 2, 3)
	  if (((x2 gr x1) ? x2-x1, x1-x2) gr 4) &
	  	(((y2 gr y1) ? y2-y1, y1-y2) gr 4) then
			switchCode=switchCode + 3
	  resultis (switchCode lshift 8)

	  // else, try again ...
	  ] repeat
	]getEventRegular