// 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")
// ]