// unparse.sr

// Last modified October 25, 1979  6:54 PM by Taft


get "BRAVO1.DF";
get "CHAR.DF";
get "MSG.DF";
get "NEWMSG.DF";
get "ST.DF";


// Incoming Procedures

external [
	stnum;
	slappend;
	slget;
	slput;
	move;
	errhlta
	];


// Incoming Statics

external	[ 
	vlook1;
	vlook2;
	vlook1old;
	vlook2old;
	deltacp;
	parstd;
	parsacred;
	ttblsacred;
	vchremain;
	vfOldtab
	vdxtb
	mpIffFfs
	vdxtbStd
	look1std
	look2std
	]


// Outgoing Procedures

external [
	unparse;
	];


// Outgoing Statics

external [
	sltrailer;
	cchNilTrailer
	vnewpar;
	vfOldtabPrev
	vdxtbPrev
	ttblPrev
	];


// Local Statics

static	[
	sltrailer;
	cchNilTrailer
	vnewpar;
	vfOldtabPrev
	vdxtbPrev
	ttblPrev
	rgiff;
	mpiffchCode
	];


// Local manifests

manifest	[
	maxch= 1001		//also defined in Write.sr
	]

// U N P A R S E 
//
let unparse(fparend) = valof
[
let sbnum = vec 10;
mpiffchCode = table
	[
// available codes:   a h m n (formerly vanish) p r w
	chnil	// iffTrailer
	chnil	// iffVisibuf
	$u	// iffUl
	chnil	// iffVanish
	$b	// iffBold
	$i	// iffItalic
	$g	// iffExt
	$v	// iffVisible
	$f	// iffFun
	$o	// iffSuper

	$z	// iffXrightmarg
	$l	// iffXleftmarg
	$d	// iffXleftmargf
	$y	// iffProcYpos
	$x	// iffLdln
	$e	// iffLdhdr
	$j	// iffRj
	$c	// iffCenter

	chnil	// iffProcClr
	chnil	// iffProcUp
	chnil	// iffProcDown
	chnil	// iffProcDxtb
	chnil	// iffProcXtb

	chnil	// iffRjCenter
	chnil	// iffProcSameLooks
	chnil	// iffProcSamePar
	chnil	// iffProcLeftmarg
	chnil	// iffProcColumn
	$q	// iffControl
	$k	// iffYkeep
	chnil	// iffProcSub

	$s	// iffOvstrike
	$t	// iffTc

//	chnil	// iffUppercase
//	chnil	// iffLowercase
//	chnil	// iffCase
//	chnil	// iffProcTable
	]
if vnewpar then
	[
	unparsepara();
	vnewpar = false;
	deltacp = 0;
	]
let tsiz1 = sltrailer>>SL.cch;
unless deltacp eq 0 do
	[
	let tchar = slget(sltrailer, tsiz1-1)
	if (tchar ge $0) & (tchar le $9) then
		slappend(sltrailer, " ", maxch);
	stnum(sbnum, deltacp, 10, 0, false, false, false);
	slappend(sltrailer, sbnum, maxch);
	]
let tsiz2 = sltrailer>>SL.cch;
unless vlook2 eq vlook2old do
	unparseword(vlook2, vlook2old, table
		[
		iffFun
		iffSuper
		iffTc
		], 3)
unless vlook1 eq vlook1old do
	unparseword(vlook1, vlook1old, table
		[
		iffUl
		iffBold
		iffItalic
		iffExt
		iffVisible
		iffOvstrike
		], 6)
test tsiz2 eq sltrailer>>SL.cch ifnot
	[
	vlook1old = vlook1;
	vlook2old = vlook2;
	deltacp = vchremain;
	]
ifso	[
	sltrailer>>SL.cch = tsiz1;
	deltacp = deltacp+vchremain;
	]
if fparend then
	[
	let tcp = sltrailer>>SL.cch
	if slget(sltrailer, tcp-1) eq chparterm then
		tcp = tcp - 1
	slput(sltrailer, tcp, chtrailerend, maxch)
	sltrailer>>SL.cch = tcp + 1
	vlook1old = look1std
	vlook2old = look2std
	]
resultis fparend;
]

// U N P A R S E P A R A
//
and unparsepara() be
[
let sbnum = vec 10;
slput(sltrailer, 0, chtrailerstart, maxch);
sltrailer>>SL.cch = 1;
cchNilTrailer = 1
unparseword(parsacred>>PAR.xrightmarg, parstd>>PAR.xrightmarg,
	table [ iffXrightmarg ], 1);
unparseword(parsacred>>PAR.xleftmarg, parstd>>PAR.xleftmarg,
	table [ iffXleftmarg ], 1);
unparseword(parsacred>>PAR.xleftmargf, parsacred>>PAR.xleftmarg,
	table [ iffXleftmargf ], 1);
if parsacred>>PAR.ypos ne parstd>>PAR.ypos then
	[
	let chCode = mpiffchCode ! iffProcYpos;
	slput(sltrailer, sltrailer>>SL.cch, chCode, maxch);
	sltrailer>>SL.cch = sltrailer>>SL.cch+1;
	stnum(sbnum, parsacred>>PAR.ypos, 10, 0, false, false, false);
	slappend(sltrailer, sbnum, maxch);
	]
unparseword(parsacred>>PAR.spec, parstd>>PAR.spec,
	table [ iffLdln; iffLdhdr; iffControl; iffRj; iffCenter ], 5);
unparseword(parsacred>>PAR.ykeep, parstd>>PAR.ykeep,
	table [ iffYkeep ], 1);
unless parsacred>>PAR.label eq 0 do
	[
	errhlta(169);
//	slput(sltrailer, sltrailer>>SL.cch, $", maxch);
//	sltrailer>>SL.cch = sltrailer>>SL.cch+1;
//	slappend(sltrailer, parsacred>>PAR.label, maxch);
//	slput(sltrailer, sltrailer>>SL.cch, $", maxch);
//	sltrailer>>SL.cch = sltrailer>>SL.cch+1;
	]
test vfOldtab ifso
	unless vfOldtabPrev & (vdxtb eq vdxtbPrev) do
		[
		let tcch = sltrailer>>SL.cch
		slput(sltrailer, sltrailer>>SL.cch, $(, maxch);
		sltrailer>>SL.cch = sltrailer>>SL.cch+1;
		stnum(sbnum, vdxtb);
		slappend(sltrailer, sbnum, maxch);
		slput(sltrailer, sltrailer>>SL.cch, $), maxch);
		sltrailer>>SL.cch = sltrailer>>SL.cch+1;
		if (vdxtb eq vdxtbStd) & (tcch eq cchNilTrailer) then
			cchNilTrailer = sltrailer>>SL.cch
		vdxtbPrev = vdxtb
		]
ifnot
	[
	let mpitbxtb = lv ttblsacred>>TTBL.ampitbxtb
	let mpitbxtbPrev = lv ttblPrev>>TTBL.ampitbxtb
	for itb = 0 to itbMax-1 do
		[
		let xtb = mpitbxtb ! itb
		if vfOldtabPrev % xtb ne mpitbxtbPrev ! itb then
			[
			slput(sltrailer, sltrailer>>SL.cch, $(, maxch);
			sltrailer>>SL.cch = sltrailer>>SL.cch+1;
			stnum(sbnum, itb);
			slappend(sltrailer, sbnum, maxch);
			slput(sltrailer, sltrailer>>SL.cch, $,, maxch);
			sltrailer>>SL.cch = sltrailer>>SL.cch+1;
			stnum(sbnum, xtb, 10, 0, false, false, false);
			slappend(sltrailer, sbnum, maxch);
			slput(sltrailer, sltrailer>>SL.cch, $), maxch);
			sltrailer>>SL.cch = sltrailer>>SL.cch+1;
			vfOldtabPrev = false
			mpitbxtbPrev ! itb = xtb
			]
		]
	]
vfOldtabPrev = vfOldtab
if sltrailer>>SL.cch eq cchNilTrailer then
	cchNilTrailer = cchNilTrailer + 1
slput(sltrailer, sltrailer>>SL.cch, chparterm, maxch);
sltrailer>>SL.cch = sltrailer>>SL.cch + 1
]


// U N P A R S E W O R D
//
and unparseword(wordnew, wordstd, rgiff, ciff) be
[
let sbnum = vec 10;
for i = 0  to ciff-1 do
	[
	let iff = rgiff ! i;
	let ffs = mpIffFfs ! iff
	let offbitRt = ffs<<FFS.offbitRt
	let cbit = ffs<<FFS.cbit
	let mask = ((1 lshift cbit)-1) lshift offbitRt
	if (wordnew & mask) ne (wordstd & mask) then
		[
		let chCode = mpiffchCode ! iff;
		if chCode eq chnil then errhlta(170)
		if (cbit eq 1) & ((wordnew & mask) eq 0) then
			chCode = chCode-#40
		slput(sltrailer, sltrailer>>SL.cch, chCode, maxch);
		sltrailer>>SL.cch = sltrailer>>SL.cch+1;
		if cbit gr 1 then
			[
			stnum(sbnum, (wordnew & mask) rshift offbitRt, 10, 0, false, false, false);
			slappend(sltrailer, sbnum, maxch);
			]
		]
	]
]