// 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