// bitmap.sr


get "BRAVO1.DF"
get "CHAR.DF"
get "DISPLAY.DF"
get "HEAP.DF"
get "MSG.DF"


// Incoming procedures

external	[
	movec
	mapcp
	tabwidth
	scanconvert
	freedl
	formaty
	makeroomww
	drawunderline;
	ugt
	ult;
	move;
	getfont;
	binsearcha;
	umin;
	errhlt;
	errhlta
	mult;
	xtoxd;
	divmod;
	ReadClock;
	max
	ydToDcbPrev
	]


// Incoming statics

external	[
	vww
	macdl
	mpdldcb
	vfont
	rgcpfirstnew
	vdoc
	vxfirst
	macww
	pbmfirstfree
	vyorig
	vdcborig
	rgmask
	vjn;
	vjw;
	widthblmin;
	vcpfirstj
	vcplastd;
	widthblave;
	vcp;
	vmapstatus;
	vlook1
	vfsspec;
	fmsg;
	msgtbl;
	vmaccr;
	rgfinfo;
	char;
	rgxw;
	vdxdleft;
	vdxdright;
	vnwrds;
	vheightd;
	vbld;
	vofset;
	mpfunfd;
	vxafirst;
	vfchoflow
	fontvis
	vRtcVertInt
	rgnwrdsnew
	mpWwWwd
	vfwheel;
	rgyfirst;
	vheightVis
	vblVis
	]


// Outgoing procedures

external	[
	makebitmap;
	replaceCnDcb;
	dlToDisplay;
	initCnDcb;
	incCnDcb;
	decCnDcb;
	chaseCnDcb;
	]


// Outgoing statics

external	[
	dcb
	cdcb
	vxdud;
	vfVertInt;
	vCnDcbFree;
	]


// Local statics

static	[
	dcb
	cdcb
	vxdud;
	vfVertInt;
	vCnDcbFree;

	font
	pwBase
	pwBaseVis
	]


// Local manifests

manifest	[
	dydUl = 0
	dydMidbar = 5
	dydOverbar = 1
	]


// M A K E C L E A R B I T M A P
// SPE catalogue no.
// let makeclearbitmap(dl) be
// [
// rgxdlastnew ! dl = -1;
// rgpbmnew ! dl = 0;
// (mpdldcb ! dl)>>DCB.nwrds = 0;
// ]


// M A K E B I T M A P

let makebitmap(dl, dld) be
[
// dld>>DLD.bdnFun = 0
// dld>>DLD.fFaultFun = false
// dld>>DLD.fCantUpd = false
let cr = 0;
fmsg = msgtbl;
rgmask = #460;
while (vdxdleft gr 0) & (cr ls vmaccr) do
	[
	vdxdleft = vdxdleft - xtoxd(rgxw ! cr);
	cr = cr + 1;
	if (rgfinfo ! cr)<<FINFO.newmsg then
		fmsg = fmsg + 2;
	] 
(rgfinfo ! cr)<<FINFO.newmsg = true;
while (vdxdright gr 0) & (vmaccr gr 0) do
	[
	vmaccr = vmaccr - 1;
	vdxdright = vdxdright - xtoxd(rgxw ! vmaccr)
	rgfinfo ! vmaccr = -1;
	] 
let xafirst = vxafirst + dxaleft - vdxdleft;

let cvt = vec lcvt;
let pbm = dld>>DLD.pbm
let nwrds = dld>>DLD.nwrds
cvt>>CVT.nwrds = nwrds;
cvt>>CVT.xb = xafirst - (vxafirst & #177760);
cvt>>CVT.rgfinfo = rgfinfo;
cvt>>CVT.rgxw = rgxw;

movec(pbm, pbm + (pbm - (offset HP.use)/16)>>HP.siz - (offset HP.use)/16 - bsiz - 1, 0);
// let heightd = dld>>DLD.dYdBm;
// let dheightbl = heightd - vbld;
// let dheight = 0;
// let ddheight = nil;
let dydBm = dld>>DLD.dYdBm;
let dydAscBm = dydBm - vbld;
let dydTop = nil;
let dydTopVis = nil;
let fun = -1;
vofset = 0;
while cr ls vmaccr do
	[ 
	let finfo = rgfinfo ! cr;
	if finfo<<FINFO.newmsg then
		[
		fmsg = fmsg + 2;
		if fmsg ! 0 eq -1 then
			break;		// and invert bitmap (vchoflow)
		if (fmsg>>FMSG.look1)<<LOOK1.vanish then
			[
			cr = cr + 1;
			loop;
			] 
		let fUpdateY = false;
		let tfun = (fmsg>>FMSG.look2)<<LOOK2.fun;
		if tfun ne fun then
			[
			font = getfont(tfun, dld) + 2;
			cvt>>CVT.font = font;
// 			test vfFaultFun ifso
// 				xbPrev = XrFromCvt(cvt, pbm)
// 			ifnot	
//			if xbPrev ne -1 then
//				[
//				let xbCur = cvt>>CVT.xb
//				drawunderline(xbPrev, xbCur - 1, pbm, 0, nwrds, heightd)
//				xbPrev = -1
//				]
			fun = tfun;
			fUpdateY = true;
			] 
		let tofset = (fmsg>>FMSG.look2)<<LOOK2.ofset;
		if tofset<<LOOK2.ofsetsgn then
			tofset = tofset + ofsetsgnext;
		if tofset ne vofset then
			[
			vofset = tofset;
			fUpdateY = true;
			];
//		ddheight = dheightbl - vofset + vbld - vheightd - dheight;
//		dheight = dheight + ddheight;
//		if ddheight ne 0 then
//			cvt>>CVT.pwBase = cvt>>CVT.pwBase +
//			    (ddheight ls 0 ? -mult(-ddheight, nwrds),
//			    mult(ddheight, nwrds));
		if fUpdateY then
			[
			dydTop = dydAscBm - vofset - (vheightd - vbld);
			pwBase = (pbm - nwrds) + mult(dydTop, nwrds);
			if ult(pwBase, pbm - nwrds) then
				errhlt("pbm")
			cvt>>CVT.pwBase = pwBase;
			];
		if (fmsg>>FMSG.look1)<<LOOK1.visible then
			[
			dydTopVis = dydAscBm - vofset - (vheightVis - vblVis);
			pwBaseVis = (pbm - nwrds) + mult(dydTopVis, nwrds);
			if ult(pwBaseVis, pbm - nwrds) then
				errhlt("pbmv")
			];
		];
	if finfo<<FINFO.bars then
		[
		let xb = cvt>>CVT.xb;
		let xbLast = xb + xtoxd(rgxw ! cr) - 1;
//		let tmod = nil;
//		let tscl = divmod(pwBase - (pbm - nwrds), nwrds, lv tmod);
		if finfo<<FINFO.lowbar then
//			drawunderline(xb, xbLast, pbm, dydTop+vheightd-2, nwrds);
			drawunderline(xb, xbLast, pbm, umin(dydAscBm-vofset+dydUl, dydBm-2), nwrds);
		if finfo<<FINFO.midbar then
			drawunderline(xb, xbLast, pbm, (finfo<<FINFO.visible ? dydTopVis, dydTop) + dydMidbar, nwrds);
		if finfo<<FINFO.overbar then
			drawunderline(xb, xbLast, pbm, (finfo<<FINFO.visible ? dydTopVis, dydTop) + dydOverbar, nwrds);
		] 
	if finfo<<FINFO.ibv then
		[
//		if ult(cvt>>CVT.pwBase, pbm - nwrds) then
//			errhlt("foo1")
		scanconvertmod(cr, cvt)
		if ugt((cvt>>CVT.xb)<<X.wordindex + 1, nwrds) then
			[
			movec(pbm, pbm + (pbm - (offset HP.use)/16)>>HP.siz - (offset HP.use)/16 - bsiz - 1, -1);
			break;
			] 
		cr = cr + 1;
		loop;
		] 
scanc:
//	if ult(cvt>>CVT.pwBase, pbm - nwrds) then
//		errhlt("foo4")
	cr = scanconvert(cr, cvt);
	] 
// if xbPrev ne -1 then
// 	[
// 	let xbCur = cvt>>CVT.xb
// 	drawunderline(xbPrev, xbCur - 1, pbm, 0, nwrds, heightd)
// 	]
// let pdcb = mpdldcb ! dl;
// pdcb>>DCB.nwrds = vnwrds;
// pdcb>>DCB.htab = vxafirst<<X.wordindex;
// pdcb>>DCB.sa = tpbm;
// pdcb>>DCB.slc = heightd rshift 1;
// ***pdcb>>DCB.bw = vfchoflow ? true, false;
] 

and scanconvertmod(cr, cvt) be
[
let tfinfo = rgfinfo ! (cr + 1);
rgfinfo ! (cr + 1) = -1;
if (rgfinfo ! cr)<<FINFO.visible then
	[
	cvt>>CVT.font = fontvis;
//	cvt>>CVT.pwBase = pwBaseVis;
	cvt>>CVT.pwBase = pwBase + mult(vheightd - vbld, cvt>>CVT.nwrds) -
	  mult(vheightVis - vblVis, cvt>>CVT.nwrds);
	scanconvert(cr, cvt)
	cvt>>CVT.font = font;
	cvt>>CVT.pwBase = pwBase;
	rgfinfo ! (cr + 1) = tfinfo;
	return;
	] 
let tlook1 = fmsg>>FMSG.look1;
if tlook1<<LOOK1.italic then
	[
	let font = cvt>>CVT.font
	let ch = (rgfinfo ! cr)<<FINFO.char;
	let pfcdReal = font + ch + font ! ch
	let dyaCh = (pfcdReal + 1)>>rh
	let chMod = #377;
	let pfcdDummy = font + chMod + font ! chMod
	move(pfcdReal - dyaCh, pfcdDummy - dyaCh, dyaCh + 2)
	(rgfinfo ! cr)<<FINFO.char = chMod
	let pwBot = pfcdDummy - 1
	while (pwBot ne pfcdDummy - dyaCh) & (rv pwBot eq 0) do
		pwBot = pwBot - 1
	for tpw = pfcdDummy - dyaCh to pwBot - 4 do
		rv tpw = rv tpw rshift ((pwBot - tpw) rshift 2)
	]	
if tlook1<<LOOK1.boldface then
	[
	let txb = cvt>>CVT.xb
	cvt>>CVT.xb = txb + 1
	scanconvert(cr, cvt)
	cvt>>CVT.xb = txb
	]
scanconvert(cr, cvt)
rgfinfo ! (cr + 1) = tfinfo;
]

// R E P L A C E C N D C B
//
and replaceCnDcb(cnDcbOld, cnDcbNew, dcbPrev, ydFirst) be
[
// let tDcbOld = cnDcbOld>>CNDCB.dcbFirst
// let tdYdOld = 0
// let tc = 0
// 	[ tdYdOld = tdYdOld+(tDcbOld>>DCB.slc lshift 1)
// 	tc = tc+1
// 	if tDcbOld eq cnDcbOld>>CNDCB.dcbLast then break
// 	tDcbOld = tDcbOld>>DCB.next
// 	] repeat
// unless (tc eq cnDcbOld>>CNDCB.cDcb) & (tdYdOld eq cnDcbOld>>CNDCB.dYd) then
// 	errhlt("cko");
// let tDcbNew = cnDcbNew>>CNDCB.dcbFirst
// let tdYdNew = 0
// tc = 0
// 	[ tdYdNew = tdYdNew+(tDcbNew>>DCB.slc lshift 1)
// 	tc = tc+1
// 	if tDcbNew eq cnDcbNew>>CNDCB.dcbLast then break
// 	tDcbNew = tDcbNew>>DCB.next
// 	] repeat
// unless (tc eq cnDcbNew>>CNDCB.cDcb) & (tdYdNew eq cnDcbNew>>CNDCB.dYd) then
// 	errhlt("ckn");
// code above is merely for debugging
// unless cnDcbNew>>CNDCB.dYd eq cnDcbOld>>CNDCB.dYd then errhlt("no")
// ***
// ckCnDcbFree()

let dcbPrevOfAfterRepOld = (cnDcbOld>>CNDCB.cDcb eq 0) ?
	dcbPrev, cnDcbOld>>CNDCB.dcbLast
let dcbPrevOfAfterRepNew = (cnDcbNew>>CNDCB.cDcb eq 0) ?
	dcbPrev, cnDcbNew>>CNDCB.dcbLast
let dcbAfterRep = dcbPrevOfAfterRepOld>>DCB.next
let dcbNextofPrev = (cnDcbNew>>CNDCB.cDcb eq 0) ? 
	dcbAfterRep, cnDcbNew>>CNDCB.dcbFirst
dcbPrevOfAfterRepNew>>DCB.next = dcbAfterRep
dcbPrev>>DCB.next = dcbNextofPrev
// vfVertInt = false
unless cnDcbOld>>CNDCB.cDcb eq 0 then
	[ 
// 	let ydNow = BeamLoc(vRtcVertInt)
// 	if ydFirst ls ydNow then
// 		[ let ydNext = ydFirst+cnDcbOld>>CNDCB.dYd
// 		until vfVertInt % (ydNext ls ydNow+dYdErr) do
// 			ydNow = BeamLoc(vRtcVertInt)
// 		] 
	(vCnDcbFree>>CNDCB.dcbLast)>>DCB.next = cnDcbOld>>CNDCB.dcbFirst
	for n = 1 to cnDcbOld>>CNDCB.cDcb do
		[ chaseCnDcb(vCnDcbFree, 1)
		(vCnDcbFree>>CNDCB.dcbLast)>>DCB.nwrds = 0
		] 
	] 
// ckCnDcbFree()
] 

// B E A M L O C
//
// and BeamLoc(rtcVertInt) = valof
// [ let tRtc = vec lnRtc
// move(rtcVertInt, tRtc, lnRtc)
// let rtcNow = vec lnRtc
// ReadClock(rtcNow)
// let dLow10 = (rtcNow>>RTC.low10 - tRtc>>RTC.low10) & (maskLow10)
// resultis (dLow10 lshift 1)
// ] 

// D L T O D I S P L A Y
//
// and dlToDisplay(cnDcbOld, cnDcbNew, upState, ww, dl, 
// 	pbm, nwrds, heightd, ld, cpFirst, cpLast, xdFirst, xdLast) be
and dlToDisplay(cnDcbOld, cnDcbNew, upState, ww, dl, dld, dldnew, cpFirst) be
[
move(dld, dldnew, lDld)
// rgpbmnew ! dl = pbm
// rgnwrdsnew ! dl = nwrds
// rgheightdnew ! dl = heightd
// mpDlLdNew ! dl = ld
rgcpfirstnew ! dl = cpFirst
// rgcplastnew ! dl = cpLast
// rgxdfirstnew ! dl = xdFirst
// rgxdlastnew ! dl = xdLast
if dld>>DLD.pbm eq 0 then dld>>DLD.nwrds = 0
let xdUd = (mpWwWwd ! ww)>>WWD.xdUd
let htab = max(dld>>DLD.xdFirst - xdUd+xaudleft, xaudleft)<<X.wordindex
let fbonw = (mpWwWwd ! ww)>>WWD.bw
initCnDcb(cnDcbNew, 0, 0)
if dld>>DLD.ld ne 0 then
	incCnDcb(cnDcbNew, 0, dld>>DLD.ld, 0, 0, fbonw)
// incCnDcb(cnDcbNew, dld>>DLD.pbm, dld>>DLD.dYdBm, htab, dld>>DLD.nwrds, (dld>>DLD.fCantUpd ? not fbonw, fbonw))
incCnDcb(cnDcbNew, dld>>DLD.pbm, dld>>DLD.dYdBm, htab, dld>>DLD.nwrds, fbonw)
let dcbFWwNext = (mpWwWwd ! (ww+1))>>WWD.dcbFirst
until (upState>>UPS.ydMacFreed ge upState>>UPS.ydCur+cnDcbNew>>CNDCB.dYd) % (((cnDcbOld>>CNDCB.dcbLast)>>DCB.next) eq dcbFWwNext) do
	upState>>UPS.ydMacFreed = upState>>UPS.ydMacFreed+chaseCnDcb(cnDcbOld, 1)
let dcbPrev = decCnDcb(cnDcbOld)
let fExact = true
let tDcb = cnDcbNew>>CNDCB.dcbLast
let tdYd = cnDcbNew>>CNDCB.dYd
if cnDcbOld>>CNDCB.dYd gr tdYd then
	[
	fExact = false;	
	incCnDcb(cnDcbNew, 0, cnDcbOld>>CNDCB.dYd-tdYd, 0, 0, fbonw)
	] 
replaceCnDcb(cnDcbOld, cnDcbNew, dcbPrev, upState>>UPS.ydCur)
upState>>UPS.ydCur = upState>>UPS.ydCur+tdYd
// mpdldcb ! dl = cnDcbNew>>CNDCB.dcbFirst
dldnew>>DLD.dcb = cnDcbNew>>CNDCB.dcbFirst
initCnDcb(cnDcbOld, tDcb, fExact ? 1, 2)
] 

// I N I T C N D C B
//
and initCnDcb(cnDcb, dcbFirst, cDcb) be
[
let dYd = 0
cnDcb>>CNDCB.dcbFirst = dcbFirst
cnDcb>>CNDCB.cDcb = cDcb
let nDcb = 1
if cDcb ne 0 do
	[ dYd = dYd+(dcbFirst>>DCB.slc lshift 1)
	if nDcb eq cDcb then break
	nDcb = nDcb+1
	dcbFirst = dcbFirst>>DCB.next
	] repeat
cnDcb>>CNDCB.dcbLast = dcbFirst
cnDcb>>CNDCB.dYd = dYd
] 

// I N C C N D C B
//
and incCnDcb(cnDcb, pbm, dYd, htab, nwrds, fbonw) = valof
[
if dYd eq 0 then errhlta(94)
let dcb = decCnDcb(vCnDcbFree)
if dcb eq 0 then errhlta(95)
if dYd<<odd then errhlta(96)
dcb>>DCB.sa = pbm; dcb>>DCB.slc = dYd rshift 1;
dcb>>DCB.htab = htab; dcb>>DCB.nwrds = nwrds; dcb>>DCB.bw = fbonw;
dcb>>DCB.next = 0;
test (cnDcb>>CNDCB.cDcb eq 0) ifso
	cnDcb>>CNDCB.dcbFirst = dcb
ifnot	(cnDcb>>CNDCB.dcbLast)>>DCB.next = dcb
cnDcb>>CNDCB.dcbLast = dcb
cnDcb>>CNDCB.cDcb = cnDcb>>CNDCB.cDcb+1
cnDcb>>CNDCB.dYd = cnDcb>>CNDCB.dYd+dYd
] 

// D E C C N D C B
//
and decCnDcb(cnDcb) = valof
[
if cnDcb>>CNDCB.cDcb eq 0 then resultis 0
let dcb = cnDcb>>CNDCB.dcbFirst
cnDcb>>CNDCB.dcbFirst = dcb>>DCB.next
cnDcb>>CNDCB.cDcb = cnDcb>>CNDCB.cDcb-1
cnDcb>>CNDCB.dYd = cnDcb>>CNDCB.dYd-(dcb>>DCB.slc lshift 1)
resultis dcb
] 

// C H A S E C N D C B
//
and chaseCnDcb(cnDcb, cDcb) = valof
[
if cDcb eq 0 then errhlta(97)
let dYd = 0
let dcb = cnDcb>>CNDCB.dcbLast
for nDcb = 1 to cDcb do
	[ dcb = dcb>>DCB.next
	if dcb eq 0 then errhlta(98)
	dYd = dYd+(dcb>>DCB.slc lshift 1)
	] 
cnDcb>>CNDCB.dcbLast = dcb
cnDcb>>CNDCB.cDcb = cnDcb>>CNDCB.cDcb+cDcb
cnDcb>>CNDCB.dYd = cnDcb>>CNDCB.dYd+dYd
resultis dYd
] 

// C K C N D C B F R E E
//
// and ckCnDcbFree() be
// [
// let dcb = vCnDcbFree>>CNDCB.dcbFirst
// let nDcb = 0; let cDcb = vCnDcbFree>>CNDCB.cDcb
// 	[ if dcb>>DCB.nwrds ne 0 then errhlt("nwd")
// 	nDcb = nDcb+1
// 	if cDcb eq nDcb then break
// 	dcb = dcb>>DCB.next
// 	] repeat
// unless dcb eq vCnDcbFree>>CNDCB.dcbLast then errhlt("cbl")
// ]


z20602(1270)