// S E L E C T . S R

get "BRAVO1.DF";
get "CHAR.DF";
get "MSG.DF";
get "CALC.DF";
get "SELECT.DF";
get "DISPLAY.DF";
get "mcur.df"

// Incoming procedures

external
	[
	endofkeystream
	underline
	errhlta
	innum
	setsel
	ult
	updateunderline
	ratio
	backdylines
	finddl
	updatewindow
	formaty
	formatx
	ugt
	move
	outnum
	bravochar
	divmod;
	resetts;
	getchar;
	gets;
	puts;
	tsmakegood;
	cpparabounds;
	blink;
	clearcaret;
	deactivateomseq;
	mpDlDld;
	BeamLoc;
	CallersFrame;
	invalidateband
	invalidatesel
	invalidatewindow
// 	ValidateDisplay
	LruInc
	SetSelReplay;
	]

// Incoming statics

external
	[
	selmain;
	tsread;
	tsstream;
	rgmaccp;
	cominstream;
	vww;
	vdoc;
	rgyfirst;
	vcp;
	vdl;
	rgcpfirst;
	vcpfirst;
	vcpatxdl;
	vcpatxdr;
	vcplast;
	vxdfirst;
	vxd;
	vxdlast;
	vxdwidth;
	tsflush;
	tscorrect;
	outstream;
	mpfnof;
	fnts;
	vselcaret;
	mpWwWwd;
	vRtcVertInt;
	macww;
	vmcur
	mcurReset
	ozonel
	vfVertInt
	vmeasurestatus
	fddlrutimer
	]

// Outgoing procedures

external
	[
	select;
	setbug;
	outsel;
	waitbug;
	nobug;
	RoundRatio
	]

// Outgoing statics

external
	[
	seljump;
	bugstate;
	xbias;
	ybias;
	cursorstate;
	vlt
	]

// Outgoing statics

static
	[
	seljump;
	i;
	bugstate;
	xbias;
	ybias;
	cursorstate;
	vlt
	]

// Local stuctures

structure BUTTONS:
	[
	blank bit 13;
	one bit 1;
	three bit 1;
	two bit 1;
	];


manifest	[ dydBumpArrow = 8; dxdBumpArrow = 13  ]

// S E L E C T
// SPE catalogue no. 118

let select(sel1, sel2, FContinue, FProc; numargs carg) be
[
TweekSel(sel1)
let fmCaller = CallersFrame() + 4
let xabug,ybug = nil,nil;
let dy = nil; // Used in case statement [sjump]
let selnew,seljump = vec sell,vec sell;
seljump >> SEL.ww = 0
let selold = sel1;
let dybug = nil;
let dywindow = nil;
let tchar = nil;
let maccp = nil;
let tcpfirst = nil;
let tcplast = nil;
let tlevel = nil;
let ttype = nil;
let wwdJump = nil
let dld = nil
let dydDlFirst = nil
let fFirstCy= true
seljump >> SEL.type = snone;
selnew >> SEL.type = snone;
selnew >> SEL.ulmode = selold >> SEL.ulmode
selnew >> SEL.cpfirstorig = selold >> SEL.cpfirst;
selnew >> SEL.cplastorig = selold >> SEL.cplast;
selnew >> SEL.xdfirstorig = -1;
selnew >> SEL.xdlastorig = -1;
let lvtoggle = (lv (vselcaret >> SEL.toggle));
@lvtoggle = 0;
let timer = nil;
cursorstate = -1
let tmcurReset = table 
	[ 0;
	0; 0; #20000; #34000; #37000; #37600; #37740; #37770; #37770; #37740; #37600; #37000; #34000; #20000; 0; 0;
	-1; -1; #120001; #134001; #137001; #137601; #137741; #137771; #137771; #137741; #137601; #137001; #134001; #120001; -1; -1;
	0; 0;
	] 
mcurReset = tmcurReset
if tsread then 
	SetSelReplay(sel1)
if tsread then 
	return;

	[
	unless (carg ge 3 ? FContinue(selold, fmCaller),
		endofkeystream()) do break;
// 	let ydNow = BeamLoc(vRtcVertInt)
// 	test ydNow gr rgyfirst ! macww ifso
// 		setbug(sreset)
// 	ifnot	setbug(sjump)
// 	loop
	xabug = rv(xbugloc)+xbias;
	i = bug >> BUTTONS.one eq 0 ? 1,
	   (bug >> BUTTONS.two eq 0 ? 2,
	   (bug >> BUTTONS.three eq 0 ? 3,0));
	if xabug ls xaudleft then i = i+4;
	if xabug ls xajump then i = i+4;
	selnew >> SEL.type = table [
		snone; schar; sword; sstar;
		snone; sline; sph; sstar;
		snone; sjump; sjump; sjump ] ! i;
	bugstate = table [
		snone; snone; snone; snone;
		sline; sline; sline; snone;
		sjump; sup; sreset; sdown ] ! i;

	test selnew >> SEL.type eq snone ifso
		[ if vfVertInt & vmeasurestatus then
			[ vfVertInt= 0
			test fFirstCy ifso
				fFirstCy = false
			ifnot
				[ vlt>>LT.cCyc= vlt>>LT.cCyc + 1
				if vlt>>LT.cCyc eq 3600 then
					[
					vlt>>LT.cCyc = 0
					vlt>>LT.cMin = vlt>>LT.cMin + 1
					]
				]
			]
		]
	ifnot
		[ vfVertInt = 0; fFirstCy = true; ];
	if i eq 7 & selold >> SEL.type eq sline then
		bugstate = sline;
	if i ls 8 & selold >> SEL.type eq sph then
		bugstate = sph;
	test bugstate eq sreset ifso
		[ let wwd = mpWwWwd ! vww; let ydFirst = rgyfirst ! vww;
		mcurReset >> MCUR.aclocOther.x = clocHwr >> CLOC.x
		mcurReset >> MCUR.aclocOther.y = ydFirst+RoundRatio(rgyfirst ! (vww+1)-ydFirst,wwd>>WWD.cpFDispl,rgmaccp ! (wwd>>WWD.doc));
		vmcur = mcurReset
		cursorstate = -1
		] 
	ifnot	[ vmcur = 0
		setbug(bugstate);
		] 
	if vselcaret >> SEL.type eq scaret then
		blink(lvtoggle,lv timer,once);
	let dydToTipArrow = selecton bugstate into
		[ 
case sline:	4
case sreset:	8
case snone:	-4
default:		0
		] 
	ybug = rv(ybugloc)+dydToTipArrow	// +ybias-4;

L2001:
// ** to com.sr **	if sel1 eq selmain then waitthings();
	formaty(ybug);
	if (vdl eq -1) then loop
	let tDoc = (mpWwWwd ! vww)>>WWD.doc
	if rgmaccp ! (tDoc) eq 0 then loop;
	test selnew >> SEL.type eq sstar ifso
		[ if selold >> SEL.doc ne tDoc
			then loop;
		ttype = selold >> SEL.type;
		] 
	ifnot	ttype = selnew >> SEL.type
	switchon ttype into
		[

case snone:	
		if seljump >> SEL.type eq snone then loop;
		underline(uloff,selold);
		updateunderline();
		vww = seljump >> SEL.ww;
		wwdJump = mpWwWwd ! vww;
		vdoc = wwdJump>>WWD.doc;

		dld = mpDlDld((mpWwWwd ! vww) >> WWD.dlFirst)
		dydDlFirst = dld >> DLD.dYdBm+dld >> DLD.ld
		dy = ybug-rgyfirst ! vww-dydDlFirst;
		switchon seljump >> SEL.type into
			[

case sreset:		dybug = ybug-rgyfirst ! vww;
			dywindow = rgyfirst ! (vww+1)-rgyfirst ! vww;
			if dybug gr dywindow then
				dybug = dywindow;
			vcp = valof 
				[ if dybug ls 10 then
					resultis 0;
				if ybug gr (rgyfirst ! (vww+1))-10 then
					resultis rgmaccp ! vdoc-1;
				resultis RoundRatio(rgmaccp ! vdoc,dybug,dywindow);
				] 
			backdylines(vww,vcp,0);
			endcase;

case sdown:		
			vcp = wwdJump>>WWD.cpFDispl;
				[
				dy = dy-backdylines(vww,vcp,dy);
				] repeatuntil (vcp eq 0) % (dy le 0)
			endcase;

case sup:		vdl = finddl(vww,seljump >> SEL.cpfirst);
			if vdl ls 0 then loop;
			vcp = rgcpfirst ! vdl;
			if vcp eq wwdJump>>WWD.cpFDispl then
			 if dy gr 0 & ult(dld>>DLD.cpLast+1,rgmaccp!vdoc) then 
			 vcp = dld>>DLD.cpLast + 1
			endcase;

			]; // end switchon

		if (ozonel ne 0) then
			[ deactivateomseq("",0)
			] 
		if ult(vcp,wwdJump>>WWD.cpFDispl) then
			[ let cpLastDispl = (mpDlDld(wwdJump>>WWD.dlLast))>>DLD.cpLast
			let dcpDispl = cpLastDispl-wwdJump>>WWD.cpFDispl
			if ult(dcpDispl rshift 1,wwdJump>>WWD.cpFDispl-vcp) then
				invalidatewindow(seljump >> SEL.ww)
			] 
		wwdJump>>WWD.cpFDispl = vcp;
		(mpDlDld(wwdJump>>WWD.dlFirst))>>DLD.xdLast = -1
		seljump >> SEL.type = snone;
		updatewindow(vww);
		underline(selold >> SEL.ulmode,selold);
		loop;

case sjump:	seljump >> SEL.type = bugstate;
		seljump >> SEL.ww = vww;
		seljump >> SEL.cpfirst = rgcpfirst ! vdl;
		loop;

case schar:	formatx(vww,vdl,xabug);
		vcpfirst = vcpatxdl;
		vcplast = vcpatxdr;
		vxdfirst = vxd;
		vxdlast = vxd+vxdwidth-1
		goto setorig;

case sword:	formatx(vww,vdl,xabug);
		goto setorig;

case sline:	dld = mpDlDld(vdl)
		vcpfirst = rgcpfirst ! vdl;
		vcplast = dld>>DLD.cpLast;
		vxdfirst =  dld>>DLD.xdFirst;
		vxdlast = dld>>DLD.xdLast;
		goto setorig;

case sph:	cpparabounds(tDoc,rgcpfirst ! vdl,lv vcpfirst,lv tcplast,lv vcplast);
		vxdfirst =  -1
		vxdlast = -1;
		goto setorig;

setorig:	seljump >> SEL.type = snone;
//	vfhp = fhpsel;
		test selnew >> SEL.type eq sstar ifnot
			[ selnew >> SEL.cpfirstorig = vcpfirst;
			selnew >> SEL.cplastorig = vcplast;
			selnew >> SEL.xdfirstorig = vxdfirst;
			selnew >> SEL.xdlastorig = vxdlast;
			] 
		ifso	test ult(vcpfirst,selold >> SEL.cpfirstorig) ifso
			[ 
			// vcpfirst = vcpfirst;
			vcplast = selold >> SEL.cplastorig;
			// vxdfirst = vxdfirst;
			vxdlast = selold >> SEL.xdlastorig;
			] 
		ifnot	[ vcpfirst = selold >> SEL.cpfirstorig;
			// vcplast = vcplast;
			vxdfirst = selold >> SEL.xdfirstorig;
			// vxdlast = vxdlast;
			] 
	] // end switchon

	selnew >> SEL.type = ttype;
	selnew >> SEL.cpfirst = vcpfirst;
	selnew >> SEL.cplast = vcplast;
	selnew >> SEL.xdfirst = vxdfirst;
	selnew >> SEL.xdlast = vxdlast;
	selnew >> SEL.ww = vww;
	selnew >> SEL.doc = tDoc;

	if sel2 & not ugt(selnew >> SEL.cpfirst,sel2 >> SEL.cplast) &
	not ugt(sel2 >> SEL.cpfirst,selnew >> SEL.cplast) & 
	(selnew >> SEL.doc eq sel2 >> SEL.doc)
		then loop;

     if	selold >> SEL.type eq ttype &
	selold >> SEL.cpfirst eq vcpfirst &
	selold >> SEL.cplast eq vcplast &
	selold >> SEL.doc eq tDoc then loop;

	if carg eq 4 then
		unless FProc(selnew, fmCaller) do loop

	(mpWwWwd ! (selnew >> SEL.ww))>>WWD.lru = LruInc(lv fddlrutimer)
	underline(uloff,selold);
	move(selnew,selold,sell);
	underline(selold >> SEL.ulmode,selold);
	updateunderline( );
	loop;
	] repeat; // end repeat
TweekSel(sel1)
clearcaret(lvtoggle);
vselcaret >> SEL.type = snone;
if carg le 2 then
	outsel(sel1 >> SEL.type,sel1 >> SEL.ww,sel1 >> SEL.cpfirst,sel1 >> 
SEL.cplast);
] // end select.

// S E T B U G
// SPE catalogue no.

and setbug(newcursorstate) be
[

	if cursorstate ne newcursorstate then
		[ 
// 		xbias = 0; ybias = 4
// 		if (cursorstate eq snone % cursorstate eq -1) & newcursorstate ne sreset then
// 			[
// 			xbias = 13; ybias = 8;
// 			rv(ybugloc) = rv(ybugloc)-ybias;
// 			rv(xbugloc) = rv(xbugloc)-xbias;
// 			] 
// 		if (cursorstate ne sreset % cursorstate eq -1) & newcursorstate eq snone then
// 			[
// 			rv(ybugloc) = rv(ybugloc)+ybias;
// 			rv(xbugloc) = rv(xbugloc)+xbias;
// 			xbias = 0; ybias = 0;
// 			] 
		test (newcursorstate eq sline) & (cursorstate eq snone) ifso
			[ rv(ybugloc) = rv(ybugloc)-dydBumpArrow;
			rv(xbugloc) = rv(xbugloc)-dxdBumpArrow;
			] 
		ifnot	[ if (newcursorstate eq snone) & (cursorstate ne -1) then
//					& (cursorstate eq sline) 
				[ rv(ybugloc) = rv(ybugloc)+dydBumpArrow;
				rv(xbugloc) = rv(xbugloc)+dxdBumpArrow;
				] 
			] 
		cursorstate = newcursorstate;
		xbias = (cursorstate eq snone) ? 0,13

		let cursor = selecton cursorstate into
			[


case snone:	table
			[
			#100000; #140000; #160000;
			#170000; #174000; #176000;
			#177000; #170000; #154000;
			#114000; #006000; #006000;
			#003000; #003000; #001400;
			#001400;
			]

case sline:	table	[
			#000000; #000000; #000000;
			#000000; #001777; #000776;
			#000374; #001770; #007560;
			#036140; #170100; #140000;
			#000000; #000000; #000000;
			#000000;
			]

case sreset:	table	[
			#000000; #017770; #017770;
			#014030; #014030; #014030;
			#014030; #014030; #014030;
			#014030; #014030; #014030;
			#014030; #017770; #017770;
			#000000;
			]

case sdown:	table	[
			#007760; #007760;
			#007760; #007760; #007760;
			#007760; #007760; #007760;
			#077776; #037774; #017770;
			#007760; #003740; #001700;
			#000600; #000000;
			]

case sup:	table	[
			#000600; #001700; #003740;
			#007760; #017770; #037774;
			#077776; #007760; #007760;
			#007760; #007760; #007760;
			#007760; #007760; #007760;
			#007760;
			]

case sjump:	table	[
			#000400; #001600; #003700;
			#007740; #017760; #001600;
			#001600; #001600;
			#001600; #001600; #017760;
			#007740; #003700; #001600;
			#000400; #000000;
			]
case sph:	table	[
			0; #3700; #7200;
			#7200; #7200; #7200;
			#7200; #3200;
			#1200; #1200; #1200;
			#1200; #1200; 0;
			0; 0;
			]
			] // end selecton

		move(cursor,curmap,16);
		] // end if
] // end setbug

// O U T S E L 
//
and outsel(type,ww,cpfirst,cplast) be
[ 
if tscorrect then return;
if type eq snone then
	[ 
	puts(fnts,$');
	tsmakegood();
	return;
	] 
let maccp = rgmaccp ! ((mpWwWwd ! ww)>>WWD.doc)
unless ult(cpfirst,maccp) & ult(cplast,maccp) then errhlta(108);
puts(fnts,${);
outnum(fnts,type,8);
puts(fnts,$,);
outnum(fnts,ww,8);
puts(fnts,$,);
outnum(fnts,cpfirst,8);
puts(fnts,$,);
outnum(fnts,cplast,8);
puts(fnts,$});
tsmakegood();
] 
// W A I T B U G
// SPE catalogue no.

and waitbug() = valof
[
let tchar = nil;
if tsread then
	[ 
	tchar = gets(fnts);
	if tchar eq ctrlc then
		resultis false;
	test tchar eq chat ifso
		[ tchar = gets(fnts);
		unless tchar eq $E do errhlta(109);
		resetts();
		tsread = false;
		tscorrect = false;
		] 
	ifnot	[ 
		rv(ybugloc) = innum(fnts,8);
		resultis true;
		] 
	] 
	[
	if not endofkeystream() then 
		[ tchar = getchar();
		if tchar eq ctrlc then
			[ puts(fnts,ctrlc);
			tsmakegood();
			resultis false;
			] 
		] 
	] repeatuntil (rv(bug) & 7) ne 7;
if tscorrect then resultis true;
puts(fnts,$y);
outnum(fnts,rv ybugloc,8);
puts(fnts,$,);
tsmakegood();
resultis true;
] // end waitbug


// N O B U G
//
and nobug() = (rv(bug) & 7) eq 7


and once() = false;


// R O U N D   R A T I O

and RoundRatio(x, a, b) = ratio(x, a, b) + (ratio(x, a lshift 1, b) & 1)

and TweekSel(sel) be
[ unless sel >> SEL.ww ls macww then
	[ sel >> SEL.ww = macww-1
	sel >> SEL.doc = (mpWwWwd ! (macww-1)) >> WWD.doc
	let maccp = rgmaccp ! (sel >> SEL.doc)
	sel >> SEL.cplast = maccp-1
	sel >> SEL.cpfirst = 0
	invalidatesel(sel)
	] 
]
 

(706)