//  parse.sr


get "BRAVO1.DF";
get "ST.DF";
get "CHAR.DF";
get "DOC.DF";
get "DISPLAY.DF";
get "PARSE.DF";
get "COM.DF";
get "RN1.DF";
get "FORMAT.DF";


// Incoming procedures

external	[
	stcopy
	stappend
	FChInSb
	stcompare
	ult
	stput
	umin
	getvch
	sttoint
	stsize
	mult
	max
	ratio
	stget
	SetRegionSys
	updatedisplay
	inserttx
	RoundRatio
	]


// Incoming statics

external	[
	vdoc
	vcp
	vmapstatus
	rgmaccp
	]


// Outgoing procedures

external	[
	FGetUserInt
	ItkNextToken
	FGetTxpInt
	FGetTxpParam
	CpSpanTxp
	ChGetTxp
	SpanTxpBlanks
	]


// Outgoing statics

// external


// Local statics

// static


// Local manifests

// manifest


// F   G E T   U S E R   I N T

let FGetUserInt(pint, riPrompt) = valof
[
SetRegionSys(risysstate, riPrompt, 37)
SetRegionSys(risyspast, rinil)
updatedisplay();
unless inserttx(1) do resultis false;
let txp = vec lntxp
txp>>TXP.doc = doctx1
txp>>TXP.cp = 0
txp>>TXP.cpMac = rgmaccp ! doctx1
let int = nil
resultis FGetTxpInt(pint, txp)
]


// I T K   N E X T   T O K E N

and ItkNextToken(txp, sbSpan, sbtk0, sbtk1, sbtk2, sbtk3, sbtk4, sbtk5, sbtk6,
	sbtk7, sbtk8, sbtk9; numargs carg) = valof
[
SpanTxpBlanks(txp)
let tsbSpan = vec 5
stcopy(tsbSpan, sbSpan)
stappend(tsbSpan, "*c")
let sbToken = vec 20
let cpToken = txp>>TXP.cp
CpSpanTxp(sbToken, txp, tsbSpan, 39, false)
let cchToken = stsize(sbToken)
let ch = ChGetTxp(txp)
if cchToken eq 0 then
	[
	if ch eq chnil then resultis itkEotx
	if ch eq chcr then resultis itkEol
	]
if ch eq chcr then txp>>TXP.cp = txp>>TXP.cp - 1
if ch eq chnil then ch = chcr
if FChInSb(ch, sbSpan) then
	[
	let tcp = cchToken-1
	while FChInSb(stget(sbToken, tcp), " *t") do
		tcp = tcp - 1
	sbToken>>SB.cch = tcp + 1
	let rgsb = lv sbtk0
	for itk = 0 to carg-3 do
		[
		let sb = rgsb ! itk
		if sb eq sbnil then loop
		if rv sb eq rv sbToken then
			if stcompare(sb, sbToken) eq 0 then
				resultis itk
		]
	]
txp>>TXP.cp = cpToken
resultis itkNil
] // end ItkNextToken


// F   G E T   T X P   I N T

and FGetTxpInt(pint, txp) = valof
[
SpanTxpBlanks(txp)
let sb = vec 5
unless FSpanTxpNumeric(sb, txp) do resultis false
let ch = ChGetTxp(txp)
if ch ne chnil then
	[
	txp>>TXP.cp = txp>>TXP.cp - 1
	unless FChInSb(ch, " *t,*c") do
		resultis false
	]
rv pint = sttoint(sb)
resultis true
] // end FGetTxpInt


// F   G E T   T X P   P A R A M

and FGetTxpParam(pint, pfSigned, txp, fMicas, fBlanks; numargs carg) = valof
[
if carg ls 5 then fBlanks = false
unless fBlanks do SpanTxpBlanks(txp)
let fSigned = false
let fNegative = false
let ch = ChGetTxp(txp)
test ch eq $+ % ch eq $- ifso
	[
	if pfSigned eq 0 then resultis false
	fSigned = true
	fNegative = ch eq $-
	]
ifnot	if ch ne chnil then txp>>TXP.cp = txp>>TXP.cp - 1

if fBlanks then
	[
	let cpStart = txp>>TXP.cp
	let cpEnd = CpSpanTxp(sbnil, txp, " ", 0, true)
	if cpEnd ne cpnil then
		[
		unless fMicas do resultis false
		if ChGetTxp(txp) ne chnil then resultis false
		let int = mult(cpEnd-cpStart, widthblave)
		rv pint = fNegative ? -int, int
		rv pfSigned = fSigned
		resultis true
		]
	]

let sb = vec 5
FSpanTxpNumeric(sb, txp)
let cchParam = stsize(sb)
let intBody = sttoint(sb)
let intFraction = 0
let intScale = 1
ch = ChGetTxp(txp)
let mlt = fMicas ? xperinch, ptsperinch
let div = ptsperinch
test ch eq $. ifso
	[
	FSpanTxpNumeric(sb, txp)
	intFraction = sttoint(sb)
	let cchFraction = stsize(sb)
	cchParam = cchParam + cchFraction
	for i = 1 to cchFraction do
		intScale = mult(intScale, 10)
	div = 1
	]
ifnot	if ch ne chnil then txp>>TXP.cp = txp>>TXP.cp - 1
if cchParam eq 0 then resultis false
let tcp = txp>>TXP.cp
let itk = ItkNextToken(txp, " *t*c", "cm", "pt", "in",
		"''",	// two single quotes
		"*"")	// one double quote
test itk ls 0 ifso
	txp>>TXP.cp = tcp
ifnot test itk eq 0 ifso
	[
	mlt = fMicas ? 1000, ptsperinch * 100
	div = fMicas ? 1, 254
	]
ifnot	div = table [ 0; ptsperinch; 1; 1; 1 ] ! itk
let int = RoundRatio(intBody, mlt, div) +
	RoundRatio(intFraction, mlt, mult(div, intScale))
rv pint = fNegative ? -int, int
if pfSigned ne 0 then rv pfSigned = fSigned
resultis true
] // end FGetTxpParam


// C P   S P A N   T X P

and CpSpanTxp(sb, txp, sbSpan, cpMacSb, fInSpan; numargs carg) = valof
[
if carg ls 5 then fInSpan = false	// i.e. continue while ch not in sbSpan
if carg ls 4 then cpMacSb = 255
let cpSb = 0
let cpStart = txp>>TXP.cp
let ch = nil
	[
	ch = ChGetTxp(txp)
	if ch eq chnil then break
	unless FChInSb(ch, sbSpan) eq fInSpan do break
	if sb ne sbnil then
		[
		unless ult(cpSb, cpMacSb) do break
		stput(sb, cpSb, ch)
		cpSb = cpSb + 1
		]
	] repeat
if sb ne sbnil then
	sb>>SB.cch = cpSb
if ch ne chnil then
	txp>>TXP.cp = txp>>TXP.cp - 1
let cpFinish = txp>>TXP.cp
if cpFinish eq cpStart then resultis cpnil
resultis cpFinish
] // end CpSpanTxp


// F   S P A N   T X P   N U M E R I C

and FSpanTxpNumeric(sb, txp) = valof
	resultis CpSpanTxp(sb, txp, "0123456789", 5, true) ne cpnil
// end FSpanTxpNumeric


// S P A N   T X P   B L A N K S

and SpanTxpBlanks(txp) be
	CpSpanTxp(sbnil, txp, " *t", 0, true)	// span blanks, tabs
// end SpanTxpBlanks


// C H   G E T   T X P

and ChGetTxp(txp) = valof
[
if vdoc ne txp>>TXP.doc % vcp ne txp>>TXP.cp then
	[
	vdoc = txp>>TXP.doc
	vcp = txp>>TXP.cp
	vmapstatus = statusblind
	]
unless ult(vcp, umin(txp>>TXP.cpMac, rgmaccp ! vdoc)) do
	resultis chnil
let ch = getvch()
txp>>TXP.cp = vcp
resultis ch
] // end ChGetTxp