// formatpage.sr
// RML November 2, 1979 4:44 PM keep all y co-ordinates in points.
// Saves time and maintains better accuracy
// RML September 23, 1977 11:53 AM - update color - XPD
// PCL April 7, 1978 - print header & page #logic to avoid excessive paper movement
// RML April 18, 1978 6:14 PM delete firstTime
// Last modified November 30, 1979 3:33 PM by Taft
get "BRAVO1.DF"
get "CHAR.DF"
get "ST.DF"
get "MSG.DF"
get "DISPLAY.DF"
get "COM.DF"
get "RN1.DF"
get "HARDCOPY.DF"
get "PCOLOR.DF"
// Outgoing Procedures
external [
CpFormatPage
CchPgbrkScan
SbRoman
]
// Outgoing Statics
// external
// Incoming Procedures
external [
format
mapcp
stnum
RoundRatio
move
divmod
mult
ult
errhlta
errhlt
establishfun
stcopy
stsize
stget
stput
stappend
max
SetRegionSys
SetRegionW
updatedisplay
establishofset
ldToSgTop
maxBlBlNew
scanconvert
getfont
movec
CallersFrame
getchar
min
stcompare
uc
]
// Incoming Statics
external [
mpWwWwd
rgmaccp
parsacred
vxfirst
vxlast
vfDiablomode
rgfinfo
vmaccr
msgtbl
vcplast
vsgh
vrgcc1
rgxw
vmapstatus
vrlwsys
vcuripar
parstd
vofset
vheighth
vblh
cursorstate
dcpendofdoc
vlook1
vlook2
look1std
look2std
EnvelopeCpLast
EnvelopeFlag
]
// Local Statics
// static
static [
CurrentcpHdr
CurrentsbPgn
hdrdone
pgnodone
]
// Local Structures
// structure
// Local Manifests
manifest [
maxfun = 11 // no room for df
dxLn = (3 * xperinch) / 20
]
// C P F O R M A T P A G E
let CpFormatPage(ww, cp, mode, ho, pi, FAbortPage, FinfoToOutput, ymul, ydiv, pcpMinusTwo; numargs carg) = valof
[
if carg ls 10 then pcpMinusTwo = 0
let fm = CallersFrame() + 4
let wwd = mpWwWwd ! ww
let doc = wwd>>WWD.doc
let cpMac = rgmaccp ! doc - dcpendofdoc
let fPrinting = mode eq modehc & FinfoToOutput ne 0
// if cp eq 0 then
// [
// vmapstatus = statusblind
// mapcp(doc, cp, parneeded)
// test parsacred>>PAR.control ifso
// [
// cp = CpParseDocProf(ho, doc, cp)
// if cp eq cpnil then resultis cpnil-1
// ]
// ifnot DefaultHo(ho)
// ]
let pgn = ho>>HO.pgnFirst + pi
let fEvenPage = ho>>HO.fAlternate ne 0 & pgn<<odd eq 0
let xwBindmarg = ho>>HO.xwBindmarg
let dxBind = fEvenPage ? -xwBindmarg, xwBindmarg
if FAbortPage ne 0 then
[
ShowPgnMod(pgn)
// SetRegionW(vrlwsys, 0, sbPgn)
// let ridPgn = nil
// ridPgn<<RID.nrl = 1
// ridPgn<<RID.ri = 0
// SetRegionSys(risyspast, 184, ridPgn)
// updatedisplay()
]
hdrdone = false
pgnodone = false
// Print Header or Page Number if on first half of page
let xhdrypos = parsacred>>PAR.ypos
if EnvelopeFlag then goto PrintText1
if ( fPrinting ) then
[
let sbPgn = lv ho>>HO.asbPgn
test ho>>HO.fRoman ifso
SbRoman(sbPgn, pgn, ho>>HO.fUppercase ne 0)
ifnot stnum(sbPgn, pgn)
let cpHdr = fEvenPage ? ho>>HO.cpHdrEven, ho>>HO.cpHdrOdd
if cpHdr ne cpnil & not (pi eq 0 & ho>>HO.fNoHdr) then
[
// let yHdr = RoundRatio(11 * ptsperinch, ymul, ydiv)
let yHdr = 11 * ptsperinch
[
format(ww, cpHdr, modehc)
let xhdrypos = parsacred>>PAR.ypos
if (xhdrypos le 250) then break
hdrdone = true
if cpHdr eq vcuripar>>IPAR.cpfirst then
[
let ypos = parsacred>>PAR.ypos
if ypos ne -1 then
// yHdr = RoundRatio(ypos, ymul, ydiv)
yHdr = ypos
]
// let dyToptobl = RoundRatio(vsgh>>SG.ldTop + vsgh>>SG.topmax, ymul, ydiv)
let dyToptobl = vsgh>>SG.ldTop + vsgh>>SG.topmax
// let dyBltobot = RoundRatio(vsgh>>SG.blmax, ymul, ydiv)
let dyBltobot = vsgh>>SG.blmax
yHdr = yHdr - dyToptobl
if FinfoToOutput(fm, cpHdr, vxfirst+dxBind, vxlast+dxBind, RoundRatio(yHdr, ymul, ydiv)) ne 0 then resultis cpMac
yHdr = yHdr - dyBltobot
if vcplast eq vcuripar>>IPAR.cplast then break
cpHdr = vcplast + 1
] repeat
]
CurrentcpHdr = cpHdr //**PCL
CurrentsbPgn = sbPgn
]
PrintText1:
let xpgnypos = ho>>HO.yPgn
if EnvelopeFlag then goto PrintText
if ( fPrinting & xpgnypos gr 140 ) then
[
pgnodone = true
let cpHdr = CurrentcpHdr //**PCL
let sbPgn = CurrentsbPgn
if not hdrdone then
[
sbPgn = lv ho>>HO.asbPgn
test ho>>HO.fRoman ifso
SbRoman(sbPgn, pgn, ho>>HO.fUppercase ne 0)
ifnot stnum(sbPgn, pgn)
cpHdr = fEvenPage ? ho>>HO.cpHdrEven, ho>>HO.cpHdrOdd
]
if ho>>HO.fPgn & not (pi eq 0 & ho>>HO.fNoPgn) then
[
test cpHdr eq cpnil ifso
FormatSb(sbPgn, mode, 0)
ifnot
[
vmapstatus = statusblind
mapcp(doc, cpHdr);
FormatSb(sbPgn, mode, 0, vlook1, vlook2);
];
let xPgn = ho>>HO.xPgn
xPgn = fEvenPage ? xwPage-xPgn, xPgn-(vxlast+1)
// let tyPgn = RoundRatio(ho>>HO.yPgn, ymul, ydiv) -RoundRatio(vsgh>>SG.ldTop+vsgh>>SG.topmax, ymul, ydiv)
let tyPgn = ho>>HO.yPgn -(vsgh>>SG.ldTop+vsgh>>SG.topmax)
FinfoToOutput(fm, cpnil, xPgn+dxBind, xPgn+vxlast+dxBind, RoundRatio(tyPgn, ymul, ydiv))
]
]
if fPrinting then
[ // Private Data
if ho>>HO.fXpd & not vfDiablomode then
[
if pi eq 0 then
unless FGetPassword("XPD") do resultis cpnil - 1
let xXpd = ho>>HO.xXpd + dxBind
let tyXpd = RoundRatio(ho>>HO.yXpd, ymul, ydiv)
test ho>>HO.fEars eq 0 ifso
[ // The following futz is so that the
// X,Y in the User Profile correspond
// to the lower, left hand corner of
// the bounding box.
// Pressfinfo works from the
// coordinates of the keyhole.
// C'est la vie !
xXpd = xXpd + 270
tyXpd = tyXpd - 80
move(table [ #100000+$X; // newmsg and X
$e; $r; $o; $x; chcr; -1 ], rgfinfo, 7)
vmaccr = 6
move(table [ -1; -1; 8; (cRedx lshift 4+maxfun) lshift 8; ],
msgtbl, 4)
if FinfoToOutput(fm, cpnil, xXpd+1500, 0,
tyXpd+1200) ne 0 then resultis cpMac
move(table [ #100000+$P; // newmsg and P
$r; $i; $v; $a; $t; $e; chcr; -1 ], rgfinfo, 9)
vmaccr = 8
if FinfoToOutput(fm, cpnil, xXpd+1500, 0,
tyXpd+850) ne 0 then resultis cpMac
move(table [ #100000+$D; // newmsg and D
$a; $t; $a; chcr; -1 ], rgfinfo, 6)
vmaccr = 5
if FinfoToOutput(fm, cpnil, xXpd+1500, 0,
tyXpd+500) ne 0 then resultis cpMac
move(table [ #100000+$A; // newmsg (keyhole)
chcr; -1 ], rgfinfo, 3)
vmaccr = 2
move(table [ -1; -1; 0;
// again, Red
(cRedx lshift 4+maxfun+2) lshift 8; ], msgtbl, 4)
if FinfoToOutput(fm, cpnil, xXpd,0,
tyXpd-50) ne 0 then resultis cpMac
]
ifnot [
move(table [ #100000+$X; // newmsg and X
$E; $R; $O; $X; chcr; -1 ], rgfinfo, 7)
vmaccr = 6
move(table [ -1; -1; 0; maxfun*256; ], msgtbl, 4)
if FinfoToOutput(fm, cpnil, xXpd+(2540*4)/5, 0, tyXpd) ne 0 then resultis cpMac
move(table [ #100000+$P; // newmsg and P
$R; $I; $V; $A; $T; $E; chcr; -1 ], rgfinfo, 9)
vmaccr = 8
if FinfoToOutput(fm, cpnil, xXpd+(2540*4)/5, 0, tyXpd-85) ne 0 then resultis cpMac
move(table [ #100000+$D; // newmsg and D
$A; $T; $A; chcr; -1 ], rgfinfo, 6)
vmaccr = 5
if FinfoToOutput(fm, cpnil, xXpd+(2540*4)/5, 0, tyXpd-85*2) ne 0 then resultis cpMac
move(table [ #100000+$A; // newmsg (border font)
$B; $C; $D; $E; $F;
#100000+$A; // newmsg (keyhole)
#100000+$G; // newmsg (border font)
$H; chcr; -1 ], rgfinfo, 11)
vmaccr = 10
move(table [ -1; -1;
0; (maxfun+1)*256;
0; (maxfun+2)*256;
0; (maxfun+1)*256; ], msgtbl, 8)
if FinfoToOutput(fm, cpnil, xXpd, 0, tyXpd-85*3) ne 0 then resultis cpMac
]
]
]
PrintText:
let fLn = ho>>HO.fLn ne 0
let lnMod = ho>>HO.lnMod
if pi eq 0 then
ho>>HO.lnLast = ho>>HO.lnFirst - 1
if ho>>HO.fPgRel then
ho>>HO.lnLast = 0
let xwEdgemarg = ho>>HO.xwEdgemarg
let xwMiddlemarg = ho>>HO.xwMiddlemarg
let ccol = ho>>HO.ccol
let tmod = nil
let xwCol = divmod(xwPage - (xwEdgemarg lshift 1 +
mult(ccol-1, xwMiddlemarg)), ccol, lv tmod)
//let tyStartOfTx = RoundRatio(ho>>HO.yStartOfTx, ymul, ydiv)
let tyStartOfTx = ho>>HO.yStartOfTx
//let tyEndOfTx = RoundRatio(ho>>HO.yEndOfTx, ymul, ydiv)
let tyEndOfTx = ho>>HO.yEndOfTx
let cpMinusOne = cp
let cpMinusTwo = cp
for icol = 0 to ccol-1 do
[
let dxCol = mult(icol, xwCol+xwMiddlemarg) + dxBind
let yTxline = tyStartOfTx
let fFirstline = true
let cchPgbrk = 0
[
unless ult(cp, cpMac) do
[
unless carg ls 10 do
rv pcpMinusTwo = cpMinusTwo
// resultis cpMac //**PCL
cp = cpMac
goto chechpgnNhdr
]
if FAbortPage ne 0 then
if FAbortPage() then
resultis cpnil
format(ww, cp, modehc)
let fTestBound = true
if EnvelopeFlag & cp gr EnvelopeCpLast then break
if cp eq vcuripar>>IPAR.cpfirst then
[
// if parsacred>>PAR.control then
// [
//
// ]
let ypos = parsacred>>PAR.ypos
if ypos ne -1 then
[
// yTxline = RoundRatio(ypos, ymul, ydiv)
yTxline = ypos
fTestBound = false
]
let ykeep = parsacred>>PAR.ykeep
if ykeep ne 0 & not fFirstline then
// if yTxline-RoundRatio(ykeep, ymul, ydiv) ls tyEndOfTx then
if yTxline-ykeep ls tyEndOfTx then
break
]
// let dyToptobl = RoundRatio((fFirstline ? 0, vsgh>>SG.ldTop) + vsgh>>SG.topmax, ymul, ydiv)
let dyToptobl = (fFirstline ? 0, vsgh>>SG.ldTop) + vsgh>>SG.topmax
// let dyBltobot = RoundRatio(vsgh>>SG.blmax, ymul, ydiv)
let dyBltobot = vsgh>>SG.blmax
yTxline = yTxline - dyToptobl
if (fTestBound & yTxline-dyBltobot ls tyEndOfTx) %
cchPgbrk gr 0 then break
test fPrinting ifso
[
cchPgbrk = FinfoToOutput(fm, cp, vxfirst+dxCol,
vxlast+dxCol, RoundRatio(yTxline, ymul, ydiv))
if fLn then
[
let ln = ho>>HO.lnLast + 1
let tmod = nil
divmod(ln, lnMod, lv tmod)
if tmod eq 0 then
[
let sbLn = vec 5
stnum(sbLn, ln)
FormatSb(sbLn, mode, 0, look1std, look2std)
let xLn = xwEdgemarg - dxLn - (vxlast+1)
FinfoToOutput(fm, cpnil, xLn+dxCol,
xLn+vxlast+dxCol,
RoundRatio(yTxline, ymul, ydiv))
]
ho>>HO.lnLast = ln
]
]
ifnot cchPgbrk = CchPgbrkScan()
yTxline = yTxline - dyBltobot
fFirstline = false
cpMinusTwo = cpMinusOne
cpMinusOne = cp
cp = vcplast + 1
] repeat
if cchPgbrk gr 1 then break
]
unless pcpMinusTwo eq 0 do
rv pcpMinusTwo = cpMinusTwo
chechpgnNhdr:
if EnvelopeFlag then resultis cp
if ( fPrinting & not hdrdone ) then
[
let sbPgn = lv ho>>HO.asbPgn
test ho>>HO.fRoman ifso
SbRoman(sbPgn, pgn, ho>>HO.fUppercase ne 0)
ifnot stnum(sbPgn, pgn)
let cpHdr = fEvenPage ? ho>>HO.cpHdrEven, ho>>HO.cpHdrOdd
if cpHdr ne cpnil & not (pi eq 0 & ho>>HO.fNoHdr) then
[
// let yHdr = RoundRatio(11 * ptsperinch, ymul, ydiv)
let yHdr = 11 * ptsperinch
[
format(ww, cpHdr, modehc)
if cpHdr eq vcuripar>>IPAR.cpfirst then
[
let ypos = parsacred>>PAR.ypos
if ypos ne -1 then
// yHdr = RoundRatio(ypos, ymul, ydiv)
yHdr = ypos
]
// let dyToptobl = RoundRatio(vsgh>>SG.ldTop + vsgh>>SG.topmax, ymul, ydiv)
let dyToptobl = vsgh>>SG.ldTop +
vsgh>>SG.topmax
// let dyBltobot = RoundRatio(vsgh>>SG.blmax, ymul, ydiv)
let dyBltobot = vsgh>>SG.blmax
yHdr = yHdr - dyToptobl
if FinfoToOutput(fm, cpHdr, vxfirst+dxBind, vxlast+dxBind, RoundRatio(yHdr, ymul, ydiv)) ne 0 then resultis cpMac
yHdr = yHdr - dyBltobot
if vcplast eq vcuripar>>IPAR.cplast then break
cpHdr = vcplast + 1
] repeat
]
CurrentcpHdr = cpHdr
CurrentsbPgn = sbPgn
] //**PCL end here
if fPrinting & not pgnodone then
[
let cpHdr = CurrentcpHdr
let sbPgn = CurrentsbPgn
if not hdrdone then
[
sbPgn = lv ho>>HO.asbPgn
test ho>>HO.fRoman ifso
SbRoman(sbPgn, pgn, ho>>HO.fUppercase ne 0)
ifnot stnum(sbPgn, pgn)
cpHdr = fEvenPage ? ho>>HO.cpHdrEven, ho>>HO.cpHdrOdd
]
if ho>>HO.fPgn & not (pi eq 0 & ho>>HO.fNoPgn) then
[
test cpHdr eq cpnil ifso
FormatSb(sbPgn, mode, 0)
ifnot
[
vmapstatus = statusblind
mapcp(doc, cpHdr);
FormatSb(sbPgn, mode, 0, vlook1, vlook2);
];
let xPgn = ho>>HO.xPgn
xPgn = fEvenPage ? xwPage-xPgn, xPgn-(vxlast+1)
// let tyPgn = RoundRatio(ho>>HO.yPgn, ymul, ydiv) - RoundRatio(vsgh>>SG.ldTop+vsgh>>SG.topmax, ymul, ydiv)
let tyPgn = ho>>HO.yPgn -
(vsgh>>SG.ldTop+vsgh>>SG.topmax)
FinfoToOutput(fm, cpnil, xPgn+dxBind, xPgn+vxlast+dxBind, RoundRatio(tyPgn, ymul, ydiv))
]
] // end here **PCL
resultis cp
] // end CpFormatPage
// C C H P G B R K S C A N
and CchPgbrkScan() = valof
[
let tfmsg = msgtbl
let cchPgbrk = 0
for cr = 0 to vmaccr-1 do
[
let finfo = rgfinfo ! cr
if finfo<<FINFO.newmsg then
tfmsg = tfmsg + 2
unless (tfmsg>>FMSG.look1)<<LOOK1.vanish do
if finfo<<FINFO.char eq chpgbrk then
cchPgbrk = cchPgbrk + 1
]
resultis cchPgbrk
] // end CchPgbrkScan
// F O R M A T S B
and FormatSb(sb, mode, xFirst, look1, look2; numargs carg) be
[
if carg ls 4 then
[
look1 = look1std
look2 = look2std
]
if mode ne modehc then
errhlt("wrong mode")
// move(table [ -1; -1; look1std; look2std ], msgtbl, 4)
msgtbl ! 0 = -1; msgtbl ! 1 = -1; msgtbl ! 2 = look1; msgtbl ! 3 = look2;
vsgh>>SG.ldTop = parstd>>PAR.lead
establishfun(look2<<LOOK2.fun, look1<<LOOK1.modchar, mode)
vofset = 0
establishofset(vsgh, vheighth, vblh, ldToSgTop, maxBlBlNew)
vxfirst = xFirst
vxlast = xFirst
vmaccr = sb>>SB.cch
for cr = 0 to vmaccr-1 do
[
let ch = sb>>SB.ch ↑ cr
rgfinfo ! cr = ch
let xw = (vrgcc1 ! ch)<<CC.width
rgxw ! cr = xw
vxlast = vxlast + xw
]
rgfinfo ! 0 = rgfinfo ! 0 + #100000 // newmsg
rgfinfo ! vmaccr = finfoterm
vxlast = vxlast - 1
] // end FormatSb
// S B R O M A N
and SbRoman(sb, int, fUppercase; numargs carg) = valof
[
if carg ls 3 then fUppercase = false
let sbSource = "iviiixlxxxcdcccm"
let rgcchcp = table
[
0 lshift 8 + 2 // 0
1 lshift 8 + 2 // 1
2 lshift 8 + 2 // 2
3 lshift 8 + 2 // 3
2 lshift 8 + 0 // 4
1 lshift 8 + 1 // 5
2 lshift 8 + 1 // 6
3 lshift 8 + 1 // 7
4 lshift 8 + 1 // 8
2 lshift 8 + 4 // 9
]
rv sb = 0
for dcp = 0 to 10 by 5 do
[
let intRem = nil
int = divmod(int, 10, lv intRem)
let tsb = vec 10
rv tsb = rgcchcp ! intRem
let cpSource = tsb>>rh
for tcp = 0 to stsize(tsb)-1 do
[
let ch = stget(sbSource, cpSource+tcp+dcp)
stput(tsb, tcp, (fUppercase ? ch - #40, ch))
]
stappend(tsb, sb)
stcopy(sb, tsb)
]
resultis int eq 0 ? sb, sbnil
] // end SbRoman
// S H O W P G N M O D
and ShowPgnMod(pgn) be
[
let cvt = vec lcvt
cvt>>CVT.nwrds = 1
let curmap = vec 16;
movec(curmap, curmap+15, 0)
cvt>>CVT.pwBase = curmap-1
cvt>>CVT.xb = 0
let font = getfont(0) + 2
cvt>>CVT.font = font
let pgnMod10 = nil;
divmod(pgn, 10, lv pgnMod10)
let chCur = $0 + pgnMod10
let trgfinfo = vec 2;
trgfinfo ! 0 = chCur;
trgfinfo ! 1 = -1
cvt>>CVT.rgfinfo = trgfinfo
cvt>>CVT.rgxw = table [ 0 ];
let pfcd = font + chCur + font ! chCur
unless (pfcd>>odd eq 0) % ((pfcd ! 1)<<lh + (pfcd ! 1)<<rh ge 16) do
[
scanconvert(0, cvt)
move(curmap, #431, 16)
]
cursorstate = -1
]
// F G E T P A S S W O R D
and FGetPassword(sbPassword) = valof
[
// "Type password term. by ESC"
SetRegionSys(risysstate, 155, 37)
updatedisplay()
let cpMac = stsize(sbPassword) + 1
if cpMac gr 9 then errhlt("gpw")
let tsb = vec 5
[
let tcp = 0
[
let ch = uc(getchar())
// SetRegionSys(risyspast, rinil)
// updatedisplay()
switchon ch into
[
case bs:
tcp = max(0, tcp-1)
endcase
case ctrlw:
tcp = 0
endcase
case chesc:
break
case chdel:
// "Command terminated"
SetRegionSys(risyspast, 13, 50)
resultis false
default:
if tcp ls cpMac then
[
stput(tsb, tcp, ch)
tcp = tcp+1
]
endcase
]
] repeat
tsb>>SB.cch = tcp
if stcompare(tsb, sbPassword) eq 0 then break
// "Incorrect password"
SetRegionSys(risyspast, 156)
updatedisplay()
] repeat
SetRegionSys(risysstate, rinil)
updatedisplay();
resultis true
] // end FGetPassword