// docprof.sr


get "BRAVO1.DF"
get "ST.DF"
get "CHAR.DF"
get "MSG.DF"
get "PARSE.DF"
get "FORMAT.DF"
get "DISPLAY.DF"
get "COM.DF"
get "HARDCOPY.DF"
get "RN1.DF"


// Outgoing Procedures

external	[
	CpParseDocProf
	DefaultHo
	]


// Outgoing Statics

// external


// Incoming Procedures

external	[
	cpparabounds
	ItkNextToken
	FGetTxpParam
	FGetTxpInt
	move
	SetRegionSys
	updatedisplay
	getchar
	max
	stput
	min
	stcompare
	ChGetTxp
	CpSpanTxp
	mapcp
	invalidatesel
	]


// Incoming Statics

external	[
	selmain
	vmapstatus
	parsacred
	]


// Local Statics

// static


// Local Structures

// structure


// Local Manifests

manifest	[
	xMax = 17 * (xperinch / 2)
	yMax = 11 * ptsperinch
	]


// C P   P A R S E   D O C   P R O F

let CpParseDocProf(ho, doc, cp) = valof
[
DefaultHo(ho)
let txp = vec lntxp
txp>>TXP.doc = doc
let sbNotFirstPage = "Not-on-first-page"
let cpLast = nil
cpparabounds(doc, cp, lv txp>>TXP.cp, lv txp>>TXP.cpMac, lv cpLast)

	[
	let fSigned = true
	let param = nil
	let titk = nil
	let itk = ItkNextToken(txp, ":", "Page Numbers",
		"Private Data Stamp",
		"Columns",
		"Margins",
		"Line Numbers",
		"Odd Heading",
		"Even Heading",
		"Heading")
	switchon itk into
		[
	case itkEotx:
		break

	case itkEol:
		loop

	case itkNil:
		goto baddocprof

// Page Numbers
	case 0:
		itk = ItkNextToken(txp, " *t*c", "Yes", "No")
		test itk eq 1 ifso
			[
			ho>>HO.fPgn = false
//			endcase
			]
		ifnot	if itk ne 0 then goto baddocprof
			[
			itk = ItkNextToken(txp, " *t*c", "Roman", "Uppercase", sbNotFirstPage)
			if itk eq itkNil then
				itk = ItkNextToken(txp, ":", sbnil, sbnil, sbnil, "X", "Y", "First Page")
			switchon itk into
				[
			case itkEotx:
			case itkEol:
				break

			case itkNil:
				goto baddocprof

			case 0:
				ho>>HO.fRoman = true
				loop

			case 1:
				ho>>HO.fUppercase = true
				loop

			case 2:
				ho>>HO.fNoPgn = true
				loop

			case 3:
				unless FGetTxpParam(lv param, lv fSigned, txp, true) do
					goto baddocprof
				ho>>HO.xPgn = param ls 0 ?
					xMax+param, param
				loop

			case 4:
				unless FGetTxpParam(lv param, lv fSigned, txp, false) do
					goto baddocprof
				ho>>HO.yPgn = param ls 0 ?
					yMax+param, param
				loop

			case 5:
				unless FGetTxpInt(lv ho>>HO.pgnFirst, txp) do
					goto baddocprof
				ho>>HO.fNoPgn = false
				ho>>HO.fNoHdr = false
				loop
				]
			] repeat
		loop

// Private Data Stamp
	case 1:
		itk = ItkNextToken(txp, " *t*c", "Yes", "No")
		test itk eq 1 ifso
			[
//			endcase
			]
		ifnot	[
			if itk ne 0 then goto baddocprof
			ho>>HO.fXpd = true
			]

			[
			itk = ItkNextToken(txp, ":", "X", "Y")
			switchon itk into
				[
			case itkEotx:
			case itkEol:
				break

			case itkNil:
				goto baddocprof

			case 0:
				unless FGetTxpParam(lv param, lv fSigned, txp, true) do
					goto baddocprof
				ho>>HO.xXpd = param ls 0 ?
					xMax+param, param
				loop

			case 1:
				unless FGetTxpParam(lv param, lv fSigned, txp, false) do
					goto baddocprof
				ho>>HO.yXpd = param ls 0 ?
					yMax+param, param
				loop
				]
			] repeat
		loop

// Columns
	case 2:
		unless FGetTxpInt(lv param, txp) do
			goto baddocprof
		if param eq 0 then goto baddocprof
		ho>>HO.ccol = param

			[
			itk = ItkNextToken(txp, ":", "Edge Margin", "Between Columns")
			switchon itk into
				[
			case itkEotx:
			case itkEol:
				break

			case itkNil:
				goto baddocprof

			case 0:
				unless FGetTxpParam(lv ho>>HO.xwEdgemarg, 0, txp, true) do
					goto baddocprof
				loop

			case 1:
				unless FGetTxpParam(lv ho>>HO.xwMiddlemarg, 0, txp, true) do
					goto baddocprof
				loop
				]
			] repeat
		loop

// Margins
	case 3:
			[
			itk = ItkNextToken(txp, ":", "Top", "Bottom", "Binding")
			switchon itk into
				[
			case itkEotx:
			case itkEol:
				break

			case itkNil:
				goto baddocprof

			case 0:
				unless FGetTxpParam(lv param, 0, txp, false) do
					goto baddocprof
				ho>>HO.yStartOfTx = 11 * ptsperinch - param
				loop

			case 1:
				unless FGetTxpParam(lv ho>>HO.yEndOfTx, 0, txp, false) do
					goto baddocprof
				loop

			case 2:
				unless FGetTxpParam(lv ho>>HO.xwBindmarg, lv fSigned, txp, true) do
					goto baddocprof
				ho>>HO.fAlternate = true
				loop
				]
			] repeat
		loop

// Line Numbers
	case 4:
		itk = ItkNextToken(txp, " *t*c", "Yes", "No")
		test itk eq 1 ifso
			[
//			endcase
			]
		ifnot	[
			if itk ne 0 then goto baddocprof
			ho>>HO.fLn = true
			]

			[
			itk = ItkNextToken(txp, " *t*c", "Page-relative")
			if itk eq itkNil then
				itk = ItkNextToken(txp, ":", sbnil, "First Line", "Modulus")
			switchon itk into
				[
			case itkEotx:
			case itkEol:
				break

			case itkNil:
				goto baddocprof

			case 0:
				ho>>HO.fPgRel = true
				loop

			case 1:
				unless FGetTxpInt(lv ho>>HO.lnFirst, txp) do
					goto baddocprof
				loop

			case 2:
				unless FGetTxpInt(lv param, txp) do
					goto baddocprof
				if param eq 0 then goto baddocprof
				ho>>HO.lnMod = param
				loop
				]
			] repeat
		loop

// Odd Heading
	case 5:
// Even Heading
	case 6:
// Heading
	case 7:
			[
			titk = ItkNextToken(txp, " *t*c", sbNotFirstPage)
			if titk eq 0 then
				[
				ho>>HO.fNoHdr = true
				loop
				]
			if titk ne itkEotx then
				goto baddocprof
			vmapstatus = statusblind
			mapcp(doc, cpLast+1, parneeded)
			unless parsacred>>PAR.control do
				goto baddocprof
			cpparabounds(doc, cpLast+1, lv param, 0, lv cpLast)
			unless itk eq 5 do
				ho>>HO.cpHdrEven = param
			unless itk eq 6 do
				ho>>HO.cpHdrOdd = param
			unless itk eq 7 do
				ho>>HO.fAlternate = true
			vmapstatus = statusblind
			mapcp(doc, cpLast+1, parneeded)
			if parsacred>>PAR.control then
				cpparabounds(doc, cpLast+1, lv txp>>TXP.cp,
					lv txp>>TXP.cpMac, lv cpLast)
			break
			] repeat
		loop
		]
	CpSpanTxp(sbnil, txp, "*c")
	ChGetTxp(txp)
	] repeat

resultis cpLast + 1

baddocprof:
SetRegionSys(risyspast, 181, 50)
selmain>>SEL.cpfirst = txp>>TXP.cp
selmain>>SEL.cplast = txp>>TXP.cp
invalidatesel(selmain)
resultis cpnil
] // end CpParseDocProf


// D E F A U L T   H O

and DefaultHo(ho) be
[
move(table
	[
	#100600;		// fPgn,
			// fRoman, fUppercase, fAlternate,
			// fXpd, fLn, fPgRel,
			// fNoPgn, fNoHdr
	1;		// pgnFirst
	xperinch*8;	// xPgn
	21*(ptsperinch/2);	// yPgn
	7*(xperinch/2);	// xXpd
	(53*ptsperinch)/5;	// yXpd
	1;		// ccol
	xleftmargstd;	// xwEdgemarg
	xleftmargstd;	// xwMiddlemarg
	0;		// xwBindmarg
	cpnil;		// cpHdrOdd
	cpnil;		// cpHdrEven
	10*ptsperinch;	// yStartOfTx
	1*ptsperinch;	// yEndOfTx
	1;		// lnFirst
	1;		// lnMod
	], ho, lnhoDefault)
] // end DefaultHo