// UL.SR Underlining

get "BRAVO1.DF"
get "DISPLAY.DF"
get "SELECT.DF"

// Incoming procedures

external
	[
	enww
	ugt
	ult
	formatx
	movec
	finddl
	mult;
	formatcp;
	mapxdxr;
	errhlt;
	abs;
	mpDlDld
	]

// Incoming statics

external
	[
	vsel
	vcpatxr
	vxd
	vxdwidth
	vheightd
	macdl
	vxleftmarg;
	vxdud;
	macww;
	mpWwWwd;
	]

// Outgoing procedures

external
	[
	underline;
	updateunderline;
	drawunderline;
	drawcaret;
	elapsed;
	blink;
	clearcaret;
	]

// Outgoing statics

external
	[
	vulmode
	cnrgul
	rgmask;
	vselcaret;
	]

// Local procedures:
//	underline1
//	drawunderline
//	clearunderline

// Local statics

static
	[
	vulmode
	cnrgul
	rgmask;
	vselcaret;
	]
// Local manifest

manifest [
	masktab = #460;
	noneneeded = 0;
	bothneeded = 3;
	firstneeded = 1
	lastneeded = 2;
	leftbiascaret = dxaleft;
	sizcaret= 7;
	rightbiascaret = sizcaret-1-leftbiascaret;
	];

// U N D E R L I N E
// SPE catalogue no.

let underline(ulmode,sel) be
[
vulmode = ulmode;
if sel >> SEL.type eq snone then return;
vsel = sel;
enww(underline1,sel >> SEL.doc);
] // end underline

// U N D E R L I N E 1
// SPE catalogue no.

and underline1(ww) be
[ let wwd = mpWwWwd ! ww
let dlfrom,txdfirst,dlto,txdlast = nil,nil,nil,nil;

if (wwd>>WWD.dlLast ls wwd>>WWD.dlFirst) %
   ugt(vsel >> SEL.cpfirst,(mpDlDld(wwd>>WWD.dlLast))>>DLD.cpLast) %
   ult(vsel >> SEL.cplast,wwd>>WWD.cpFDispl) then return;
dlfrom = finddl(ww,vsel >> SEL.cpfirst);
dlto = finddl(ww,vsel >> SEL.cplast);
txdfirst = vsel >> SEL.xdfirst;
txdlast = vsel >> SEL.xdlast;
vxdud = wwd>>WWD.xdUd
test dlfrom ls 0 ifso
	[
	dlfrom = wwd>>WWD.dlFirst;
	txdfirst = (mpDlDld(dlfrom))>>DLD.xdFirst;
	if vsel >> SEL.type eq scaret then
		return;
	];
ifnot	[ if txdfirst ls 0 % ww ne vsel >> SEL.ww then
		[ formatcp(ww,dlfrom,vsel >> SEL.cpfirst);
		txdfirst = vxd;
		if ww eq vsel >> SEL.ww then
			vsel >> SEL.xdfirst = txdfirst;
		] 
	] 
test dlto ls 0 ifso
	[
	dlto = wwd>>WWD.dlLast;
	txdlast = (mpDlDld(dlto))>>DLD.xdLast;
	];
ifnot	[ if txdlast ls 0 % ww ne vsel >> SEL.ww then
		[ formatcp(ww,dlto,vsel >> SEL.cplast);
		txdlast = vxd+vxdwidth-1;
		if ww eq vsel >> SEL.ww then
			vsel >> SEL.xdlast = txdlast;
		] 
	] 

if vsel >> SEL.type eq scaret then
	[ vsel >> SEL.cplast = vsel >> SEL.cpfirst-1
	drawcaret(ww,dlfrom,txdfirst);
	return;
	] 
test dlfrom eq dlto ifso
	trydrawunderline(ww,dlfrom,txdfirst,txdlast)
ifnot	[
	trydrawunderline(ww,dlfrom,txdfirst,-1);
	for i = dlfrom+1 to dlto-1 do
		trydrawunderline(ww,i,-1,-1);
	trydrawunderline(ww,dlto,-1,txdlast);
	];
] // end underline1

// T R Y D R A W U N D E R L I N E

and trydrawunderline(ww,dl,xdfirst,xdlast) be
[ let dld = mpDlDld(dl)
if xdfirst eq -1 then xdfirst = dld>>DLD.xdFirst
if xdlast eq -1 then xdlast = dld>>DLD.xdLast
if (xdlast ls xdfirst) % (dld>>DLD.xdLast ls 0) then return;
let tul = dld>>DLD.ul
test (xdfirst eq dld>>DLD.xdFirst) & (xdlast eq dld>>DLD.xdLast) ifso
	[
	test vulmode eq uloff ifso
		if tul gr ulunknown & tul ls ulMaxNorm then
			[
			dld>>DLD.ul = tul + ulMaxNorm
			cnrgul = cnrgul+1;
			return;
			]
	ifnot if (tul - ulMaxNorm) eq vulmode then
		[
		dld>>DLD.ul = vulmode;
		cnrgul = cnrgul-1;
		return;
		];

	if tul ge ulMaxNorm then cnrgul = cnrgul-1;
	dld>>DLD.ul = vulmode;
	]
ifnot	[
	if tul ge ulMaxNorm then clearunderline(dl);
	dld>>DLD.ul = ulunknown;
	];

rgmask = selecton vulmode into
	[
case uloff:	table [ 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0 ]
case ulmode1: 	masktab	// Hardware Mask
case ulmode2:	table
		[
		#1;#3;#3;#3;#23;#63;#63;#63;#463;#1463;#1463;
		#1463;#11463;#31463;#31463;#31463
		]		// Dotted line mask
default:	masktab	// Hardware Mask as default
	];

let xdhd = (mpWwWwd ! ww)>>WWD.xdUd - xaudleft;
let xdfirstindl = dld>>DLD.xdFirst;
let nwrds = dld>>DLD.nwrds;
let xrfirst = mapxdxr(xdhd,xdfirstindl,xdfirst);
if xrfirst ls dxaleft then
	xrfirst = dxaleft;
let xrlast = mapxdxr(xdhd,xdfirstindl,xdlast);
if xrlast gr (nwrds lshift 4) then
	xrlast = (nwrds lshift 4);

drawunderline(xrfirst,xrlast,dld>>DLD.pbm,(dld>>DLD.dYdBm)-1,nwrds);
] // end trydrawunderline

// D R A W U N D E R L I N E
//
and drawunderline(xrfirst,xrlast,pbm,height,nwrds,dyd; numargs na) be
[ if xrlast ls xrfirst then return;
if na ls 6 then dyd = 1
let maskGr = #10421
for tdyd = 0 to dyd-1 do
	[ let pwbase = pbm+mult(nwrds,height+tdyd);
	let pwfrom = pwbase+xrfirst << X.wordindex;
	let pwto   = pwbase+xrlast << X.wordindex;
	
	let width,shift = nil,nil;
	let maskGrSh = maskGr lshift ((tdyd << odd) ? 2,0)
	test pwfrom eq pwto ifso
		[
		width = xrlast-xrfirst;
		shift = 15-(xrlast << X.bitindex);
		let tmask = (rgmask ! width) lshift shift
		let tw = (rv pwfrom) & (not ((masktab ! width) lshift shift))
		rv pwfrom = (na ls 6) ? tmask % tw,@pwfrom % (tmask & maskGrSh)
		]
	ifnot	[
		width = 15-(xrfirst << X.bitindex);
		let tmask = (rgmask ! width)
		let tw = rv pwfrom & (not (masktab ! width))
		rv pwfrom = (na ls 6) ? tmask % tw,@pwfrom % (tmask & maskGrSh)
		for i = pwfrom+1 to pwto-1 by 1 do
			rv i = (na ls 6) ? rgmask ! 15,@i % maskGrSh; // Full Underline;
		shift = 15-xrlast << X.bitindex;
		width = xrlast << X.bitindex;
		tmask = (rgmask ! width) lshift shift
		tw = rv pwto & (not ((masktab ! width) lshift shift))
		rv pwto = (na ls 6) ? tmask % tw,@pwto % (tmask & maskGrSh);
		];
	] 
] // end drawunderline

// U P D A T E U N D E R L I N E

and updateunderline() be
[
if cnrgul gr 0 then
	for ww = 0 to macww-1 do
		[ let wwd = mpWwWwd ! ww
		vxdud = wwd>>WWD.xdUd;
		for dl = wwd>>WWD.dlFirst to wwd>>WWD.dlLast do
			if (mpDlDld(dl))>>DLD.ul ge ulMaxNorm then clearunderline(dl);
		] 
cnrgul = 0;
] // end clearunderline

// C L E A R U N D E R L I N E

and clearunderline(dl) be
[
let dld = mpDlDld(dl);
let width = dld>>DLD.nwrds;
let pwbase = dld>>DLD.pbm+mult(width,(dld>>DLD.dYdBm)-1);
movec(pwbase,pwbase+width-1,0);
if dld>>DLD.ul ge ulMaxNorm then cnrgul = cnrgul-1;
dld>>DLD.ul = uloff
]
// D R A W C A R E T

and drawcaret(ww,dl,xd) be
[
let dld = mpDlDld(dl)
let xdhd = (mpWwWwd ! ww)>>WWD.xdUd - xaudleft;
let xdfirstindl = dld>>DLD.xdFirst;
let nwrds = dld>>DLD.nwrds;
let xr = mapxdxr(xdhd,xdfirstindl,xd);
if (xr ls dxaleft) % (xr gr (nwrds lshift 4)) then
	return;

let pwby = nwrds;
let pwceil = dld>>DLD.pbm;
let pwbase = pwceil + pwby*(dld>>DLD.dYdBm-1);
let pwfrom = pwbase+(xr-leftbiascaret) << X.wordindex;
let pwto   = pwbase+(xr+rightbiascaret) << X.wordindex;

let shiftfrom = 1 + ((xr+rightbiascaret) << X.bitindex);
let shiftto = 15-((xr+rightbiascaret) << X.bitindex);

let tmask = table [ #143; #66; #66; #34; #34; #10 ] ;

for i = 0 to 5 do
	[
	if pwfrom ne pwto then
		rv pwfrom = ((tmask ! i ) rshift shiftfrom) xor
			(rv pwfrom);
	rv pwto = ((tmask ! i) lshift shiftto) xor (rv pwto);
	pwfrom = pwfrom - pwby;
	pwto = pwto - pwby;
	];

vselcaret >> SEL.dl = dl;
vselcaret >> SEL.toggle = vselcaret >> SEL.newtoggle;
] // end drawcaret

// E L A P S E D
//
and elapsed(millisecs, nstates, ptimer, ptoggle) = valof
	[
	test @ptoggle eq 0
		ifso	[
			@ptimer = @#430;
			@ptoggle = 1;
			];
		ifnot	[
			let t = millisecs/40;
			if abs(@#430 - @ptimer) ge t then
				[
				@ptimer = @#430;
				let ttoggle = @ptoggle + 1 ;
				resultis (ttoggle gr nstates) ?
					1,ttoggle;
				];
			];
	resultis 0 ;
	] // end of elapsed



// B L I N K
//
and blink(lvtoggle,lvtimer,condition) be
[ 
	[ vselcaret >> SEL.newtoggle = elapsed(((rv lvtoggle eq 1) ? 300,500),2,lvtimer,lvtoggle);
	if vselcaret >> SEL.newtoggle then
		underline(ulmode1,vselcaret);
	] repeatwhile condition()
] 

// C L E A R C A R E T
//
and clearcaret(lvtoggle) be
[ if rv lvtoggle eq careton then
	underline(ulmode1,vselcaret);
]