// GFORMAT.SR	Format horizontal // ** changed for looksp/tab

get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF"	// **

// Incoming procedures

external
	[
	mapcp
	establishww
	binsearcha
	divmod;
	ugt;
	ult
	cppara // **
	paraspec
	specstate
	nextspecstate
	cppage
	pagecp
	bitmapwidth // **
	]

// Incoming statics

external
	[
	xleftmargstd // $$
	vlookremark
	vcp
	rgmaccp
	vchremain
	vlb
	vpw
	vrgcc
	rgxfirst
	rgcpfirst
	rgcplast
	rgdoc
	macww
	rgylast
	rgyfirst
	vheight
	rgdlfirst
	rgdllast
	vlookctrl
	vquad
	vlook
	vpara
	rgchoppage
	rgcpfdispl // **
	]

// Outgoing procedures

external
	[
	format;
	formatx;
	formaty;
	tabwidth;
	settabs;
	]

// Outgoing statics

external
	[
	cplt
	mactab
	vwidth
	vww
	chtype
	vx
	vxlast
	vcplast
	vxrightmarg
	cplswt
	vxleftmarg
	vxfirst
	vcpatx
	vbetwixt
	vcpfirst
	rgxtab
	char
	vdl
	vjn;
	vjw;
	vcpfirstj;
	vcplastd;
	widthblmin;
	widthblave;
	]

// Local statics

static
	[
	cplt
	mactab
	vwidth
	vww
	chtype
	vx
	vxlast
	vcplast
	vxrightmarg
	cplswt
	vxleftmarg
	vxfirst
	vcpatx
	vbetwixt
	vcpfirst
	rgxtab
	char
	vdl
	vjn;
	vjw;
	vcpfirstj;
	vcplastd;
	widthblmin;
	widthblave;
	]

// F O R M A T 
// catalogue no. = 111
let format(doc,cp,devtype; numargs N) be // $$
[
if N ls 3 then devtype = devalto // $$
vpara = cppara(doc, cp) // **
vcp = specstate(doc, cp, vpara) // **
let changecp = nextspecstate() // **
vcpfirstj = vcp; // **
let x = vxleftmarg;
let xlswt = -1;
let cc = nil;
let breakcharlast = false;
let breakcharcurrent = nil;
let tcplswt = nil
let inword = true;
let widthch = nil;
let cbliu = 0; let cbltu = 0; let cbltot = 0; let cbltul = 0;
let tcbltu = 0;
let txlast = nil;
let dx = nil;
vxfirst = vxleftmarg;
let stopcp = rgchoppage ! doc? // *** assumes vww is set !!!!!! :
		pagecp(doc, cppage(doc, rgcpfdispl ! vww) + 1),
  		rgmaccp ! doc // **
	[
	if vcp eq stopcp then // ** was rgmaccp
		[ vcp = vcp-1;
		goto earlyend;
		] 
	mapcp(doc,vcp);
	while vchremain do
		[ test vlb ifso
			[ char = vpw >> lh;
			vlb = false;
			] 
		ifnot	[ char = vpw >> rh;
			vlb = true;
			vpw = vpw+1;
			]
		if vcp eq changecp then // **
			[
			changecp = nextspecstate() // **
			if changecp eq -1 then char = chcr
			]
		cc = vrgcc ! char;
		vchremain = vchremain-1;
		if ((vlook & mvanish) ne 0) %
		    (((vlook & mremark) ne 0) & (not vlookremark))
			then goto skipz // ** // $$
		widthch = devtype eq devdp?
				dpwidthcc, cc << CC.width; // $$
		chtype = cc << CC.wrd; // -
		breakcharcurrent = cc << CC.breakchar;
		if cc << CC.spec then
			[ 
// Actions for control characters may go here
			if vquad & char ne chsp then // **
				[ tcbltu = cbltu;
				cbltu = 0;
				] 
			test char eq chsp
			ifso	[
				if vquad then
					[
					cbliu = cbliu+1;
					cbltu = cbltu+1;
					widthch = vquad eq fcenter?
					    widthblave, widthblmin;
					] 
				goto noskip
				]
			ifnot test char ls #40 ifso
				[ switchon char into
					[ 
case chcr:				goto noskip;
case chlf:				goto skipz;
case chtab:				widthch = vquad eq fcenter?
				 		64, tabwidth(x)
					cbliu = 0;
					cbltu = 0;
					cbltot = 0;
					vcpfirstj = vcp;
					goto noskip;
default:				if vlookctrl then
						[ char=char+#140
						 widthch =
					  (vrgcc+char) >> CC.width;
						] 
					goto noskip;
					] 
				] 
			ifnot if char gr #177 then
				[ if char eq chblind then
					[ vcp = vcp+1;
					loop;
					] 
				if vlookctrl then
					[ if char gr #300 then
						[ widthch = (vrgcc+char-#200) >> CC.width;
						char = char-#100;
						] 
					widthch = (vrgcc+char-#100) >> 
CC.width;
					char = char-#100;
					] 
				goto noskip;
				] 
skipz:			widthch = 0;
			breakcharcurrent = false // **
			goto laftspec;
noskip:			goto laftspec;
			];
laftspec:	test breakcharlast ifnot
			[
			breakcharlast = breakcharcurrent;
			tcplswt = vcp;
			]
		ifso	[ test breakcharcurrent
			  ifso	tcplswt = vcp;
			  ifnot	[
				breakcharlast = false;
				cplswt = tcplswt;
				xlswt = x-1;
				cbltot = cbltot+cbliu;
				cbliu = 0;
				cbltul = tcbltu;
				] 
			] 
		if x+widthch gr vxrightmarg then
			goto endofline
		x = x+widthch;
		if (char eq chcr)  then
			[ 
earlyend:		vcplast = vcp;
			vxlast = x-1;
			if vquad then // **
			test vquad eq fjust
			ifso
				[ 
				cbltot = cbltot+cbliu;
				txlast = vxlast+cbltot*(widthblave-widthblmin);
				test txlast le vxrightmarg ifso
					[ 
					vjn =0;
					vjw = widthblave;
					vxlast = txlast;
					] 
				ifnot
					[
					vjw =
					 divmod(vxrightmarg-vxlast,
					   cbltot,lv vjn)+widthblmin;
					vxlast = vxrightmarg-1;
					] 
				] 
			ifnot if vquad eq fcenter then
				[
				dx = (vxrightmarg-vxlast) rshift 1;
				vxlast = vxlast+dx;
				vxfirst = vxfirst+dx;
				] 
			vcplastd = vcplast;
			goto exitformat;
			] 
		vcp = vcp+1;
		] 
	] repeat
endofline:
test xlswt gr 0 ifso
	[ vxlast = xlswt;
	vcplast = cplswt;
	] 
ifnot	[ vxlast = x-1;
	vcplast = vcp-1;
	] 
test vquad eq fjust & (cbltot-cbltul ne 0)
ifso	[ 
	vcplastd = vcplast-cbltul;
	vjw = divmod(vxrightmarg-vxlast+(cbltul*widthblmin),
			cbltot-cbltul,lv vjn)+widthblmin;
	vxlast = vxrightmarg-1;
	] 
ifnot test vquad eq fcenter ifso
	[ vcplastd = vcplast-cbltul;
	vxlast = vxlast-(cbltul*widthblave);
	dx = (vxrightmarg-vxlast) rshift 1;
	vxfirst = vxfirst+dx;
	vxlast = vxlast+dx;
	] 
ifnot	vcplastd = vcplast;
exitformat:
vwidth = bitmapwidth(vxfirst, vxlast) ; // **
] 

// F O R M A T X
// catalogue no. = 112 
and formatx(ww,dl,xparam) be
[ vx = -1;
let cp = rgcpfirst ! dl;
let doc = rgdoc ! ww;
vpara = cppara(doc, cp) // **
vcp = specstate(doc, cp, vpara) // **
if vquad then
	[
	let svww = vww // just in case
	format(doc,cp);
	vcp = specstate(doc, cp, vpara) // **
	vww = svww
	]
let changecp = nextspecstate() // **
if xparam & xparam ls vxleftmarg then
	xparam = vxleftmarg;
let cc = nil;
let x = rgxfirst ! dl;
let shifted = vxleftmarg - x // **
let cplast = rgcplast ! dl;
let xltb = x;
let xlte = nil;
let cpltb = cp;
let cplte = nil;
let widthch = nil;
let ustat = -1;
	[ mapcp(doc,vcp);
	while vchremain do
		[ test vlb ifso
			[ char = vpw >> lh;
			vlb = false;
			] 
		ifnot	[ char = vpw >> rh;
			vlb = true;
			vpw = vpw+1;
			] 
		if vcp eq changecp then // **
			[
			changecp = nextspecstate() // **
			if changecp eq -1 then char = chcr
			]
		vchremain = vchremain-1;
		cc = vrgcc ! char;
		if ((vlook & mvanish) ne 0) %
		    (((vlook & mremark) ne 0) & (not vlookremark))
			then goto skipz // ** // $$
		chtype = cc << CC.wrd;
		widthch = cc << CC.width;
		if cc << CC.spec then
			[ 
// Actions for control characters may go here
			test char eq chsp
			ifso	[
				if vquad then // **
				test vquad eq fjust // **
				ifso test ugt(vcp,vcpfirstj)
					ifso	[
						widthch = vjw;
						if vjn gr 0 then
						  widthch=widthch+1
						vjn = vjn-1;
					 	if ugt(vcp,vcplastd)
						  then widthch = 0;
					 	]
					 ifnot widthch = widthblmin;
				ifnot if vquad eq fcenter then
					[ widthch = widthblave;
					if ugt(vcp,vcplastd) then
						widthch = 0;
					] 
				goto noskip
				]
			ifnot test char ls #40
			ifso	[ switchon char into
					[ 
case chcr:				goto noskip;
case chlf:				goto skipz;
case chtab:				widthch = vquad eq fcenter?
				      		64, // **-
					  tabwidth(x+shifted);
					goto noskip;
default:				if vlookctrl then
						[ char = char+#140;
						widthch = (vrgcc+char) >> CC.
width;
						] 
					goto noskip;
					] 
				] 
			ifnot	if char gr #177 then
					[
					if char eq chblind then
						[ vcp = vcp+1;
						loop;
						] 
					if vlookctrl then // map chrs > 200
						[ if char gr #300 then
							[
							widthch =
							 (vrgcc+char-#200)>>CC.width
							char = char-#100;
							] 
						widthch =
							 (vrgcc+char-#100)>>CC.width
						char = char-#100;
						] 
				 goto noskip;
				 ] 
skipz:			widthch = 0;
			goto laftspecx;
noskip:			goto laftspecx;
			];
laftspecx:	test ustat eq chtype ifnot
			[
			if vx ge 0 then
				goto endofunit;
			xltb = x;
			cpltb = vcp;
			xlte = x+widthch-1;
			cplte = vcp;
			ustat = chtype;
			] 
		ifso	[ xlte = x+widthch-1;
			cplte = vcp;
			] 
		test xparam eq 0 ifso
			[ unless ult(vcp,vcpatx) then
				[ vx = x 
				vwidth = widthch;
				return;
				] 
			] 
		ifnot if (x+(widthch rshift vbetwixt) gr 
xparam) & (vx ls 0) then
			[ vx = x;
			vcpatx = vcp;
			vwidth = widthch;
			] 
		if vcp eq cplast then
			[ if vx ls 0 then
				[ vx = x;
				vwidth = widthch;
				vcpatx = vcp;
				] 
			goto endofunit
			] 
		vcp = vcp+1;
		x = x+widthch;
		] 
	] repeat
endofunit:
vcplast = cplte;
vxlast = xlte;
vcpfirst = cpltb;
vxfirst = xltb;
]

// F O R M A T Y
// catalogue no.
and formaty(y) be
[ for ww = 0 to macww-1 do
	[ vww = ww;
	if (rgylast ! ww ge y) then break;
	] 
establishww(vww);
let ty = rgyfirst ! vww;
let deltay = vheight;
for dl = rgdlfirst ! vww to rgdllast! vww do
	[ vdl = dl;
	ty = ty+deltay;
	if ty gr y then break;
	] 
] 

// T A B W I D T H
// catalogue no. = 144
and tabwidth(x) = valof
[ let i = binsearcha(rgxtab,mactab,x+tabwidthmin); // ** GYPSY
i = i+1;
test i ge mactab ifso
	resultis tabwidthstd
ifnot	resultis (rgxtab ! i)-x;
] 
// S E T T A B S
//
and settabs(siz) be
[ rgxtab ! 0 = 0;
rgxtab ! 1 = xleftmargstd;
for i = 2 to maxtab-1 do
	rgxtab ! i = rgxtab ! (i-1)+siz;
rgxtab ! maxtab = 10000;
mactab = maxtab;
]