// formats.sr
// Last modified November 26, 1979  2:31 PM by Taft


get "BRAVO1.DF"
get "FORMAT.DF"
get "CHAR.DF"
get "MSG.DF"
get "DISPLAY.DF"


// Incoming procedures

external	[
	errhlta
	errhlt
	movec
	mapcp
	establishfun
	makefmsg
	establishofset
	ldToSgTop
	maxBlBlNew
	ult
	widthvis
	XtbFromDxtb
	XtbFromTc
	umin
	umax
	divmod
	mult
	max
	min
	]


// Incoming statics

external	[
	mpWwWwd
	vofsetPrev
	vofset
	vcp
	vheighth
	vheightd
	vmapstatus
	vchremain
	vsgd
	vsgh
	rgmaccp
	parsacred
	vcuripar
	vlb
	vpw
	vlook1
	vlook2
	vfa
	vfun
	vfwheel
	vblh
	vbld
	vchfrremain
	vfOldtab
	vdxtb
	ttblsacred
	vdxtbStd
	fontvis
	vheightVis
	vblVis
	dcpendofdoc
	]


// Outgoing procedures

external	[
	format;
	]


// Outgoing statics

external	[
	fmsg;
	msgtbl;
	rgxw;
	rgfinfo;
	vmaccr;
	vww;
	vxd;
	vxdlast;
	vxdfirst;
	vxdwidth;
	vcplast;
	vxrightmarg;
	vxleftmarg;
	vcpatxdl;
	vcpatxdr;
	vcpfirst;
	char;
	vdl;
	vxfirst;
	vxlast;
	vfsspec;
	vrgcc1;
	vrgcc2;
	vxafirst;
	vdxdleft;
	vdxdright;
	vnwrds;
	vtl;
	vld;
	fvbuf;
	fvis;
	fext;
	vfchoflow
	vYdofDl
	]


// Local statics

static	[
	fmsg;
	msgtbl;
	rgxw;
	rgfinfo;
	vmaccr;
	vww;
	vxd;
	vxdlast;
	vxdfirst;
	vxdwidth;
	vcplast;
	vxrightmarg;
	vxleftmarg;
	vcpatxdl;
	vcpatxdr;
	vcpfirst;
	char;
	vdl;
	vxfirst;
	vxlast;
	vfsspec;
	vrgcc1;
	vrgcc2;
	vxafirst;
	vdxdleft;
	vdxdright;
	vnwrds;
	vtl;
	vld;
	fvbuf;
	fvis;
	fext;
	vfchoflow
	vYdofDl

	cr
	x1
	x2
	crBl
	ccrBl
//	crVanRun
	x1Brk
	x2Brk
	crBlBrk
	ccrBlBrk
	]


// local manifests

manifest	[ 
	bnbTab = 0
	bnbNonbreak = 1
	bnbBreak = 2

	crNil = #377;
	]


// F O R M A T 
// catalogue no. = 111
let format(ww, cp, mode, dld; numargs na) be
[
if (mode eq 0) & (na ls 4) then errhlta(190);
vww = ww;
let wwd = mpWwWwd ! ww;
let doc = wwd>>WWD.doc;

cr = 0;
crBl = crNil;
ccrBl = 0;
vcp = cp;
let crVanRun = crNil;
let dcpVanRun = 0;

let crBrk = crNil;
let cpBrk = nil;
let crVanRunBrk = crNil;
let dcpVanRunBrk = 0;

let ch = nil;
let dx1 = nil;
let cc = nil;
let bnbCurrent = nil;
let bnbPrev = bnbNonbreak;
let fFirstcall = true;
let tlook1 = nil;
let tfinfo = nil;
let tfinfobase = nil;
let inword = nil;
let inwordlast = #377;
let fJustify = nil;
let fHd = wwd>>WWD.fHd ne 0 & mode ne modehc;
let tfun = -1;
let tfa = -1;
let fRbrk = false;
let ofset = 0;
let fBlacktab = false
// let fCase = nil
// let fUpper = nil
let dxBmOflow = 0
let x1Lim = nil;
let cpLim = rgmaccp ! doc - (mode eq modehc ? dcpendofdoc, 0);
vofset = 0;
vheighth = -1;
vheightd = -1;
vmapstatus = statusblind;
vchremain = 0;
fext = false;
fvis = false;
fvbuf = false;
movec(vsgd, vsgd+sgl-1, 0)
movec(vsgh, vsgh+sgl-1, 0)
fmsg = msgtbl;
fmsg>>FMSG.look1 = -1;
fmsg>>FMSG.look2 = -1;
vfchoflow = false
if mode eq modex then
	movec(rgfinfo, rgfinfo+maxcharperline-1, 0);

	[
	unless vchremain do
		[ 
startmap:
		unless ult(vcp, cpLim) then
			[
			fRbrk = true;
			break;
			];
		test fFirstcall ifso
			[
			mapcp(doc, vcp, parneeded);
			vfsspec = parsacred>>PAR.spec;
			vxleftmarg = parsacred>>PAR.xleftmarg;
			vxrightmarg = parsacred>>PAR.xrightmarg;
			vld = vfsspec<<FSSPEC.ldln;
			test vcuripar>>IPAR.cpfirst eq vcp ifso
				[
				vxfirst = parsacred>>PAR.xleftmargf;
				vld = vld + vfsspec<<FSSPEC.ldhdr;
				]
			ifnot	vxfirst = vxleftmarg;
			x1Lim = vxrightmarg;
			if mode ne modehc & not fHd then
				[
				vxfirst = (vxfirst + 16) & #177740;
				x1Lim = (x1Lim + 16) & #177740;
				];
//			let twidth = (vrgcc1 ! (vlb ? vpw>>lh, vpw>>rh))<<CC.width;
//			if twidth gr (x1Lim-vxfirst) then
//				x1Lim = vxfirst+twidth+10;
			x1 = vxfirst;
			x2 = (fHd ? (x1 + 16) & #177740, x1);
			vxdfirst = x2 rshift 5;
			vsgh>>SG.ldTop = max(0, vld+vofsetPrev);
			vofsetPrev= 0;
// vofsetPrev= min offset of previous line
			vsgd>>SG.ldTop = vld;
			fJustify = vfsspec<<FSSPEC.rj ne 0;
			]
		ifnot	mapcp(doc, vcp);
		tlook1 = vlook1<<LOOK1.bits;
		if (tlook1 ne fmsg>>FMSG.look1) % (vlook2 ne fmsg>>FMSG.look2) then
			[
			let fUpdateSg = false
			fFirstcall = false;
//			fCase = tlook1<<LOOK1.cases;
//			fUpper = tlook1<<LOOK1.uppercase;
			fext = tlook1<<LOOK1.ext;
			fvis = tlook1<<LOOK1.visible & mode ne modehc;
//			if fvis then
//				[
//				let tmod = nil;
//				vheightVis = fontvis ! -2;
//				vblVis = divmod(vheightVis, 5, lv tmod);
//				];
			fvbuf = tlook1<<LOOK1.visibuf & mode ne modehc;
// Edit code for new system here
			vofset = vlook2<<LOOK2.ofset;
			if vofset<<LOOK2.ofsetsgn then
				vofset = vofset % ofsetsgnext;
			if (tfun ne vlook2<<LOOK2.fun) % ((mode eq modehc % fHd) & (tfa ne tlook1<<LOOK1.modchar)) then
				[
				tfun = vlook2<<LOOK2.fun;
				tfa = tlook1<<LOOK1.modchar;
				unless establishfun(tfun, tfa, mode) do
					[
					tlook1<<LOOK1.modchar = vfa;
					vlook2<<LOOK2.fun = vfun;
					];
// I don't like this
				vmapstatus = resetchpters;
				mapcp(doc, vcp);
				fUpdateSg = true;
				];
			tfa = tlook1<<LOOK1.modchar;
			tfinfobase = 0;
			if mode ne modex then
				[
				makefmsg(mode, tlook1, vlook2);
				if tfa then
					tfinfobase<<FINFO.ibv = true;
//				if (tlook1<<LOOK1.ul) % (vfwheel & fext) then
				if (tlook1<<LOOK1.ul) then
					tfinfobase<<FINFO.lowbar = true;
				if tlook1<<LOOK1.visible then
					establishofset(vsgd, vheightVis, vblVis, ldToSgTop, maxBlBlNew);
				if vofset ne ofset then
					[
					ofset = vofset;
					fUpdateSg = true;
					];
				];
			if fUpdateSg then
				[
				establishofset(vsgh, vheighth, vblh, ldToSgTop, maxBlBlNew);
				establishofset(vsgd, vheightd, vbld, ldToSgTop, maxBlBlNew);
				];
			tfinfo = tfinfobase;
			if mode ne modex then
				tfinfo<<FINFO.newmsg = true;
			];
		if vlook1<<LOOK1.vanish then
			[
			dcpVanRun = 0;
			unless vlook1<<LOOK1.trailer do
				crVanRun = cr;
			tfinfo<<FINFO.fNoCk = true;
			while ult(vchremain, vchfrremain) do
				[
				dcpVanRun = dcpVanRun + vchremain;
				vcp = vcp + vchremain;
				mapcp(doc, vcp);
				];
			if tlook1<<LOOK1.trailer then
				vchremain = vchremain-1;
			vcp = vcp + vchremain;
			dcpVanRun = dcpVanRun + vchremain;
			rgxw ! cr = 0;
			if mode eq modex then
				[
				tfinfo<<FINFO.trans = true;
				tfinfo<<FINFO.newmsg = true;
				makefmsg(mode, dcpVanRun);
				];
			rgfinfo ! cr = tfinfo;
			cr = cr + 1;
			unless vlb do
				vchremain = vchremain + 1;
			vpw = vpw + vchremain rshift 1;
			vlb = vchremain<<odd eq 0;
			test tlook1<<LOOK1.trailer ifso
				[
				if mode ne modex then
					[
					tlook1<<LOOK1.vanish = false;
					makefmsg(mode, tlook1, vlook2);
					if fvis then
						tfinfo<<FINFO.overbar = true;
					];
				vchremain = 1;
				]
			ifnot	[
				vchremain = 0;
				loop;
				];
			];
		];
tight1:
	test vlb ifso
		[
		ch = vpw>>lh;
		vlb = false;
		]
	ifnot	[
		ch = vpw>>rh;
		vlb = true;
		vpw = vpw+1;
		];
//	if fCase then
//		test fUpper ifso
//			if ch ge $a & ch le $z then
//				ch = ch - #40
//		ifnot	if ch ge $A & ch le $Z then
//				ch = ch + #40;
	vchremain = vchremain-1;
		[
		cc = vrgcc1 ! ch;
		bnbCurrent = (cc<<CC.breakchar ?
			(ch eq chtab ? bnbTab, bnbBreak), bnbNonbreak);
		if (bnbPrev & bnbCurrent) eq 0 then
			[
			if bnbCurrent ne bnbBreak then
				[
				crBrk = cr;
				x1Brk = x1;
				x2Brk = x2;
				crBlBrk = crBl;
				ccrBlBrk = ccrBl;
				cpBrk = vcp;
				crVanRunBrk = crVanRun;
				dcpVanRunBrk = dcpVanRun;
				];
			];
		bnbPrev = bnbCurrent;
		dx1 = cc<<CC.width;
		dxBmOflow = max(dxBmOflow, (vrgcc2 ! ch)<<CC.width)
		unless cc<<CC.spec do
			goto tight2;
// speccode:
		test ch le chsp ifso
			[
			let dxVis = 0;
			if fvis then
				[
				dxVis = widthvis(ch);
				if dxVis ne 0 then
					[
					tfinfo<<FINFO.ibv = true;
					tfinfo<<FINFO.visible = true;
					if fvbuf then
						[
						dx1 = dxVis;
						break;
						];
					];
				];
			switchon ch into
				[ 
case chsp:
				if fJustify then
					[
					dx1 = widthblmin;
					ccrBl = ccrBl + 1;
					ch = crBl;
					crBl = cr;
					tfinfo<<FINFO.space = true;
					];
				tfinfo<<FINFO.fNoCk = true;
				break;

case chtab:
				[
				let fMustUse = x1 eq vxfirst;
				let xtb = valof
					[
					if (vfsspec<<FSSPEC.center) then
						resultis x1 + vdxtbStd;
					if fJustify then
//						AdjustX(mode, true, crNil, x1Lim, true);
						Justify(widthblmin, 0, 0);
					if vfOldtab then
						resultis XtbFromDxtb(x1, vdxtb);
					let tc = vlook2<<LOOK2.tc;
					let txtb = XtbFromTc(x1, tc, ttblsacred);
					if ult(txtb, x1+dxtbMin) & not fMustUse then
						[
						fBlacktab = true;
						resultis x1Lim;
						];
					if tc ne tcPlain then
						fMustUse = true;
					resultis txtb;
					]
				if mode ne modehc & not fHd then
					xtb = (xtb + 16) & #177740;
				if ult(xtb, x1+dxtbMin) & fMustUse then
					xtb = vxfirst + dxtbMin;
				if (not ult(xtb, x1Lim)) & fMustUse then
					[
					fBlacktab = true;
					xtb = x1Lim - (mode ne modehc & not fHd ? 32, 1);
					];
				dx1 = xtb - x1;
				tfinfo<<FINFO.space = true;
				];
				break;

case chcr:
				if mode ne modehc then
//					dx1 = (vrgcc2 ! ch)<<CC.width;
					dx1 = widthblave;
				fRbrk = true;
				tfinfo<<FINFO.fNoCk = true;
				break;

case chpgbrk:
				if mode eq modehc then break;
default:
//				unless fext do dx1 = dxVis;
				if fext eq 0 % (dx1 eq 0 & dxVis ne 0) then
					dx1 = dxVis
				if dx1 eq 0 & ch ne chlf then
					[
					tfinfo<<FINFO.overbar = true;
					ch = ch + #140;
					loop;
					];
				break;
				];
			]
		ifnot test ch ls #177 ifso
			break
		ifnot test ch ls #200 ifso
			[
			tfinfo<<FINFO.overbar = true;
			ch = #77;
			break;
			]
		ifnot
			[
			tfinfo<<FINFO.midbar = true;
			ch = ch - #200;
			loop;
			];
 		] repeat;
tight2:
	if mode eq modex then
		[
		inword = cc<<CC.wrd;
		tfinfo<<FINFO.trans = (inword eq inwordlast ? 0,
			(inword ? swtrans, wstrans));
//		if inword ne inwordlast then
//			(rgfinfo ! cr)<<FINFO.trans = (inword ? swtrans, wstrans);
//		(rgfinfo ! cr)<<FINFO.fNoCk = tfinfo<<FINFO.fNoCk;
//		(rgfinfo ! cr)<<FINFO.char = ch;
		inwordlast = inword;
		];
	rgfinfo ! cr = ch + tfinfo;
	x1 = x1 + dx1;
	let dx2 = (fHd ? (x1 - x2 + 16) & #177740, dx1);
	rgxw ! cr = dx2;
	x2 = x2 + dx2;
	vcp = vcp + 1;
	cr = cr + 1;
	unless ult(x1, x1Lim) % tfinfo<<FINFO.fNoCk % cr le 1 do
		[
		if crBrk eq crNil then
			[
			cr = cr - 1;
			x1 = x1 - dx1;
			x2 = x2 - dx2;
			vcp = vcp - 1;
			fRbrk = true;
			];
		break;
		];
	if fRbrk then
		break;
	if cr ge maxcharperline then
		[
		cr = cr-1;
		vfchoflow = true;
		];
	tfinfo = tfinfobase;
	goto (vchremain ? tight1, startmap);
	] repeat;

// endfloop:
unless fRbrk do
	[
	cr = crBrk;
	x1 = x1Brk;
	x2 = x2Brk;
	crBl = crBlBrk;
	ccrBl = ccrBlBrk;
	vcp = cpBrk;
	crVanRun = crVanRunBrk;
	dcpVanRun = dcpVanRunBrk;
	];

if fJustify % (vfsspec<<FSSPEC.center ne 0) then
	AdjustX(mode, fJustify, crNil, x1Lim, fRbrk);
vmaccr = cr;
vxlast = x1 - 1;
vxdlast = x2 rshift 5 - 1;
vcplast = vcp - 1;

if crVanRun eq vmaccr-1 then
	[
	vmaccr = vmaccr-1;
	vcplast = vcplast-dcpVanRun;
	];

if mode eq 0 then
	[
	let dxdBitmap = dxBmOflow rshift 5;
	if fBlacktab then
		establishofset(vsgd, vheightVis, vblVis, ldToSgTop, maxBlBlNew);
	vbld = vsgd>>SG.blmax;
 	dld>>DLD.dYdBm = ((vsgd>>SG.topmax+vbld) + 1) & (-2);
	let xdhd = wwd>>WWD.xdUd-xaudleft;
	vxafirst = max(vxdfirst-xdhd, xaudleft);
	let xalast = min(vxdlast-xdhd, xaudright);
	vdxdleft = max(0, wwd>>WWD.xdUd-vxdfirst);
	vdxdright = max(0, vxdlast-xdhd-xaudright);
	if fBlacktab & vdxdright eq 0 then
		[
		xalast = xalast + widthvis(chlf) rshift 5;
		rgfinfo ! vmaccr = #21000 + chlf;	// ibv, visible
		rgxw ! vmaccr = 0;
		vmaccr = vmaccr + 1;
		];
	dld>>DLD.nwrds = xalast gr vxafirst ?
		(((xalast+max(dxdBitmap, dxaleft)+max(dxdBitmap, dxaright)-(vxafirst & #177760)+31)
		rshift 5) lshift 1), 2;
	dld>>DLD.ld = ((vsgd>>SG.ldTop) + 1) & (-2);
	dld>>DLD.cpLast = vcplast;
	dld>>DLD.xdFirst = vxdfirst; dld>>DLD.xdLast = vxdlast;
	];
vheighth = vsgh>>SG.topmax+vsgh>>SG.blmax;
vblh = vsgh>>SG.blmax;
vtl>>TL.ww = ww;
vtl>>TL.cpfirst = cp;
vtl>>TL.cplast = vcplast;
vtl>>TL.maccr = vmaccr;
vtl>>TL.mode = mode;
rgfinfo ! vmaccr = finfoterm;
]


// A D J U S T   X

and AdjustX(mode, fJustify, crAdjust, xTarget, fMax) be
[
let crSep = cr;
let x2Sep = x2;
let tdxBl = widthblave - widthblmin;

while crSep gr (crAdjust eq crNil ? 0, crAdjust + 1) do
	[
	crSep = crSep - 1;
//	if crSep eq crVanRun then
//		loop;
	let finfo = rgfinfo ! crSep;
	unless finfo<<FINFO.fNoCk do
		break;
	let dx2 = rgxw ! crSep;
	if crSep eq crBl then
		[
		ccrBl = ccrBl - 1;
		crBl = finfo<<FINFO.char;
		(rgfinfo ! crSep)<<FINFO.char = chsp;
		rgxw ! crSep = widthblave;
		x2 = x2 + tdxBl;
		x2Brk = x2Brk + tdxBl;
		];
	x2Sep = x2Sep - dx2;
	];

let dx1End = xTarget - x2Sep;
let dx2End = (mode ne modehc ? (dx1End + 16) & #177740, dx1End);
test fJustify ifso
	[
	if ccrBl eq 0 then return;
	if dx2End ls 0 then errhlt("ajx");
	if fMax then
		dx2End = min(dx2End, mult(ccrBl, tdxBl));
	x2 = x2 + dx2End;
	x1 = x2;
	x2Brk = x2Brk + dx2End;
	x1Brk = x2Brk;
	let dxJust = nil;
	let ccrTweak = nil;
	let dxTweak = nil;
	test mode eq modehc ifso
		[
		dxJust = divmod(dx2End, ccrBl, lv ccrTweak) + widthblmin;
		dxTweak = 1;
		]
	ifnot
		[
		dxJust = divmod(dx2End rshift 5, ccrBl, lv ccrTweak) lshift 5 + widthblmin;
		dxTweak = 32;
		];
	Justify(dxJust, ccrTweak, dxTweak);
	]
ifnot
	[
	let tmod = nil;
	dx2End = (mode eq modehc ? divmod(dx2End, 2, lv tmod),
		divmod(dx2End rshift 5, 2, lv tmod) lshift 5);
	x2 = x2 + dx2End;
	x1 = x2;
	x2Brk = x2Brk + dx2End;
	x1Brk = x2Brk;
	test crAdjust eq crNil ifso
		[
		vxfirst = vxfirst + dx2End;
		vxdfirst = vxdfirst + dx2End rshift 5;
		]
	ifnot
		rgxw ! crAdjust = rgxw ! crAdjust + dx2End;
	];
] // end AdjustX


// J U S T I F Y

and Justify(dxJust, ccrTweak, dxTweak) be
[
while crBl ne crNil do
	[
	let tcrBl = crBl;
	rgxw ! tcrBl = dxJust + (ccrTweak eq 0 ? 0, valof
		[
		ccrTweak = ccrTweak - 1;
		resultis dxTweak;
		]);
	crBl = (rgfinfo ! tcrBl)<<FINFO.char;
	(rgfinfo ! tcrBl)<<FINFO.char = chsp;
	];
ccrBl = 0;
crBlBrk = crNil;
ccrBlBrk = 0;
] // end Justify


z20602(1411)