-- texdisp.mesa

-- last written by Doug Wyatt, February 5, 1980  11:02 PM

-- Display output routines for TEX

DIRECTORY
	TexDefs: FROM "TexDefs",
	TexDispDefs: FROM "TexDispDefs",
	TexFontDefs: FROM "TexFontDefs" USING [CharHt,CharDp],
	TexGlueDefs: FROM "TexGlueDefs",
	TexIODefs: FROM "TexIODefs",
	TexNodeDefs: FROM "TexNodeDefs",
	TexMemDefs: FROM "TexMemDefs",
	XGraphicsDefs: FROM "XGraphicsDefs",
	InlineDefs: FROM "InlineDefs";


TexDisp: PROGRAM 
IMPORTS TexMemDefs,TexIODefs,TexFontDefs,XGraphicsDefs,InlineDefs
EXPORTS TexDispDefs =
BEGIN OPEN TexDefs, TexNodeDefs, TexGlueDefs, TexDispDefs;

DEBUG: BOOLEAN = FALSE;
shrinkcharsEnabled: BOOLEAN = TRUE;

micasPerInch: Dimn=2540;
leftMargin: Dimn=micasPerInch; -- one inch
topMargin: Dimn=micasPerInch; -- also one inch

TexDispConfusion: PUBLIC SIGNAL = CODE;

listDir: Direction ← vlist; -- {vlist, hlist}

DDimn: TYPE = LONG INTEGER; -- Display dimension, measured in micas

DDArray: TYPE = DESCRIPTOR FOR ARRAY OF DDimn;
nilDDArray: DDArray = DESCRIPTOR[NIL,0];

scalingFactor: LONG INTEGER ← unitScaling;
Scale: PROCEDURE[d: Dimn] RETURNS[DDimn] = INLINE
	BEGIN
	RETURN [(d*scalingFactor)/unitScaling];
	END;

micasPerDot: INTEGER=32;
Round: PROCEDURE[d: DDimn] RETURNS[DDimn] = 
	BEGIN
	RETURN [
	  IF d>=0 THEN ((d+micasPerDot/2)/micasPerDot)*micasPerDot
	  ELSE ((d-micasPerDot/2)/micasPerDot)*micasPerDot];
	END;

RoundDown: PROCEDURE[d: DDimn] RETURNS[DDimn] = 
	BEGIN
	RETURN [
	  IF d>=0 THEN (d/micasPerDot)*micasPerDot
	  ELSE ((d-micasPerDot+1)/micasPerDot)*micasPerDot];
	END;

RoundUp: PROCEDURE[d: DDimn] RETURNS[DDimn] = 
	BEGIN
	RETURN [
	  IF d>=0 THEN ((d+micasPerDot-1)/micasPerDot)*micasPerDot
	  ELSE (d/micasPerDot)*micasPerDot];
	END;

RS: PROCEDURE[d: Dimn] RETURNS[DDimn] = INLINE
	BEGIN RETURN [Round[Scale[d]]]; END;

displayFonts: DisplayFonts;
bitMap: POINTER TO XGraphicsDefs.Bitmap;
screenTop, screenRight, screenBottom, screenLeft: DDimn;
charString: STRING ← [1]; -- holds single charcter for PutTextInBitmap

-- font initialization

InitDisplayFont: PUBLIC PROCEDURE[
	fontname: STRING,
	mode: XGraphicsDefs.textMode,
	f: Font,
	fonts: DisplayFonts] =
	BEGIN
	fonts[f].mode←mode;
	WHILE (fonts[f].strike←XGraphicsDefs.GetStrikeHandle[fontname])=NIL
		DO
		BEGIN OPEN TexIODefs;
		UseDisplay;
		Ws["HELP!  Cannot find AL file for "]; Ws[fontname];
		SIGNAL TexDispConfusion;
		END;
		ENDLOOP;
	END;

-- display routines

DisplayPage: PUBLIC PROCEDURE[p: BoxNodePtr, x, y: Dimn, scaling: INTEGER] =
	BEGIN
	-- p is the vlist box for the page
	-- x,y are page-relative coordinates for top,left of rectangle to display
	-- scaling is factor by which all dimensions are expanded
		-- integer treated as fixed point with 10 bit fraction
	screenx, screeny, screenw, screenh: CARDINAL;
	b: POINTER TO XGraphicsDefs.Bitmap;
	-- screenx and screeny are dot numbers in bitmap for x,y of page
	-- screenh and screeny are height and width in dots of rectangle in bitmap
	-- displayFonts maps from TEX font numbers to strike fonts for display
	-- b is a pointer to the bitmap for the display
	screenx2, screeny2: CARDINAL;

	b←XGraphicsDefs.GetDefaultBitmapHandle[];
	screenx←screeny←0; screenw←b.nBits; screenh←b.nLines;

	-- set up program variables
	scalingFactor←scaling;
	bitMap←b;
	charString.length←1;
	IF screenx>=b.nBits OR screeny>=b.nLines
		OR screenh<= 0 OR screenw<=0 THEN RETURN;
	screenTop←DotsToDDimn[screeny];
	screenLeft←DotsToDDimn[screenx];
	screenRight←DotsToDDimn[screenx2←MIN[b.nBits,screenx+screenw]];
	screenBottom←DotsToDDimn[screeny2←MIN[b.nLines,screeny+screenh]];

	-- *** for now, everything is a single font!
	InitDisplayFont["texscreenfont", XGraphicsDefs.normal, 0, displayFonts];

	-- now do it
	XGraphicsDefs.EraseAreaInBitmap[screenx,screeny,screenx2-1,screeny2-1,b];
	DisplayVlist[p,RS[leftMargin-x]+screenLeft,RS[topMargin-y]+screenTop]
	END;

BoxNodePtrCheck: PROCEDURE[pp: NodePtr] RETURNS[BoxNodePtr] =
	BEGIN -- verify that pp points to a box Node
	WITH node:pp SELECT FROM
		box => RETURN [@node];
		ENDCASE => NULL;
	SIGNAL TexDispConfusion; RETURN [NIL];
	END;

DisplayHlist: PROCEDURE[
	pp: NodePtr, x,y: DDimn, sizes: DDArray ← nilDDArray] =
	-- x,y are left,baseline for box in screen coordinate system
	BEGIN
	freeSizes: BOOLEAN;
	p: BoxNodePtr ← BoxNodePtrCheck[pp];
	qptr, qq: NodePtr;
	prevdir: Direction←listDir;
	nchild: CARDINAL; -- use as index into widths

	-- get the sizes for display
	IF p.dir#hlist THEN SIGNAL TexDispConfusion;
	listDir←hlist;
	IF sizes = nilDDArray THEN BEGIN sizes←GetSizes[p]; freeSizes←TRUE; END
	ELSE freeSizes←FALSE;

	-- go through the list doing the display
	qq←p.head; nchild←0;
	WHILE qq#NIL DO
		qptr←qq; -- qptr is used so that q is not invalidated if qq changes
		BEGIN
		WITH q:qptr SELECT FROM
		char => DisplayCharacter[q.c, x, y];
		string =>
			BEGIN
			i: CARDINAL;
			f: Font←q.font;
			FOR i IN[0..q.length)
				DO
				DisplayCharacter[[f,q.text[i]], x, y];
				x←x+sizes[nchild]; nchild←nchild+1;
				ENDLOOP;
			GOTO Done;
			END;
		glue, space, kern => NULL;
		rule =>
			BEGIN
			h: DDimn←Scale[IF q.height<0 THEN p.height ELSE q.height];
			d: DDimn←Scale[IF q.depth<0 THEN p.depth ELSE q.depth];
			w: DDimn←Scale[q.width]; -- use this instead of sizes[nchild]
				-- since sizes may have been increased to stretch things
			DisplayRectangle[x,Round[y-h],RoundUp[h+d],RoundUp[w]];
			END;
		box => SELECT q.dir FROM
			vlist => DisplayVlist[@q,x,y-RS[q.height-q.shiftamt]];
			hlist => DisplayHlist[@q,x,y+RS[q.shiftamt]];
			ENDCASE => ERROR;
		leader =>
			BEGIN
			s: DDimn←sizes[nchild]; -- space to be filled with leaders
			gptr: NodePtr←q.link; -- pointer to node following leader Node
			IF gptr=NIL THEN
				BEGIN SIGNAL TexDispConfusion; GOTO Exit END;
			WITH gptr SELECT FROM -- should be glue node
				glue => qq←gptr; -- so that skip this glue on next loop
				ENDCASE => BEGIN SIGNAL TexDispConfusion; GOTO Exit END;
			WITH b:q.p SELECT FROM -- should be rule or box
				box =>
					BEGIN
					lsizes: DDArray; -- sizes array for leader box
					xx: DDimn; -- starting place for box leaders
					xend: DDimn←x+s;
					ww: DDimn←RS[b.width]; -- box width on display
					IF ww<=0 THEN GOTO Exit;
					xx←ww*((x/ww)+1); -- the smallest suitable multiple of ww
					SELECT b.dir FROM
					hlist =>
						BEGIN
						lsizes←GetSizes[@b];
						WHILE xx+ww<=xend DO
							DisplayHlist[@b,xx,y,lsizes]; xx←xx+ww ENDLOOP;
						END;
					vlist =>
						BEGIN
						yy: DDimn ← y-RS[b.height];
						listDir←vlist; lsizes←GetSizes[@b]; listDir←hlist;
						WHILE xx+ww<=xend DO
							DisplayVlist[@b,xx,yy,lsizes]; xx←xx+ww ENDLOOP;
						END;
					ENDCASE => ERROR;
					FreeSizes[lsizes];
					END;
				rule => -- variable horizontal rule
					-- *** now uses RoundUp for height .. DKW
					DisplayRectangle[x,y-RS[b.height],
										RoundUp[Scale[b.height+b.depth]],s];
					-- note: ignores width of rule
					-- doesn't check for negative height or depth either
				ENDCASE => BEGIN SIGNAL TexDispConfusion; GOTO Exit END;
			EXITS Exit => NULL;
			END;
		ENDCASE => GOTO Done;
							-- ignore all other types of nodes
		x←x+sizes[nchild]; nchild←nchild+1;
		EXITS Done => NULL END;
		qq←qq.link; -- NOT q.link; qq may have been changed!
		ENDLOOP;

	IF freeSizes THEN FreeSizes[sizes];
	listDir←prevdir;

	END;

DisplayVlist: PROCEDURE[
	pp: NodePtr, x,y: DDimn, sizes: DDArray ← nilDDArray] =
	-- x,y are left,top for box in screen coordinate system
	BEGIN
	p: BoxNodePtr ← BoxNodePtrCheck[pp];
	freeSizes: BOOLEAN;
	qptr, qq: NodePtr;
	prevdir: Direction←listDir;
	nchild: CARDINAL; -- use as index into y's

	-- get the sizes for display
	IF p.dir#vlist THEN SIGNAL TexDispConfusion;
	listDir←vlist;
	IF sizes = nilDDArray THEN BEGIN sizes←GetSizes[p]; freeSizes←TRUE; END
	ELSE freeSizes←FALSE;

	-- go through the list doing the display
	qq←p.head; nchild←0;
	WHILE qq#NIL DO
		qptr←qq; -- qptr is used so that q is not invalidated if qq changes
		WITH q:qptr SELECT FROM
		char => DisplayCharacter[q.c, x, y+CharacterDisplayHeight[q.c]];
		glue, space, kern => NULL;
		rule =>
			BEGIN
			h: DDimn←Scale[q.height+q.depth];
				-- use this instead of sizes[nchild]
				-- since sizes may have been increased to stretch things
			w: DDimn←Scale[IF q.width<0 THEN p.width ELSE q.width];
			DisplayRectangle[x,y,RoundUp[h],RoundUp[w]];
			END;
		box => SELECT q.dir FROM
			vlist => DisplayVlist[@q,x+RS[q.shiftamt],y];
			hlist => DisplayHlist[@q,x+RS[q.shiftamt],y+RS[q.height]];
			ENDCASE => ERROR;
		leader =>
			BEGIN
			s: DDimn←sizes[nchild]; -- space to be filled with leaders
			gptr: NodePtr←q.link; -- pointer to node following leader Node
			IF gptr=NIL THEN
				BEGIN SIGNAL TexDispConfusion; GOTO Exit END;
			WITH gptr SELECT FROM -- should be glue node
				glue => qq←gptr; -- so that skip this glue on next loop
				ENDCASE => BEGIN SIGNAL TexDispConfusion; GOTO Exit END;
			WITH b:q.p SELECT FROM -- should be rule or box
				box =>
					BEGIN
					lsizes: DDArray; -- sizes array for leader box
					yy: DDimn; -- starting place for box leaders
					yend: DDimn←y+s;
					hh: DDimn←RS[b.height+b.depth];
					IF hh<=0 THEN GOTO Exit;
					yy←hh*(y/hh+1); -- the smallest suitable multiple of hh
					SELECT b.dir FROM
					hlist =>
						BEGIN
						boxh: DDimn ← RS[b.height];
						listDir←hlist; lsizes←GetSizes[@b]; listDir←vlist;
						WHILE yy+hh<=yend DO
							DisplayHlist[@b,x,yy+boxh,lsizes]; yy←yy+hh ENDLOOP;
						END;
					vlist =>
						BEGIN
						lsizes←GetSizes[@b];
						WHILE yy+hh<=yend DO
							DisplayVlist[@b,x,yy,lsizes]; yy←yy+hh ENDLOOP;
						END;
					ENDCASE => ERROR;
					FreeSizes[lsizes];
					END;
				rule => -- variable horizontal rule
					-- *** now uses RoundUp for width .. DKW
					DisplayRectangle[x,y,s,RoundUp[Scale[b.width]]];
					-- note: ignores width of rule
					-- doesn't check for negative width either
				ENDCASE => BEGIN SIGNAL TexDispConfusion; GOTO Exit END;
			EXITS Exit => NULL;
			END;
		ENDCASE => BEGIN qq←qq.link; LOOP; END;
							-- ignore all other types of nodes
		qq←qq.link; -- NOT q.link; qq may have been changed!
		y←y+sizes[nchild]; nchild←nchild+1;
		ENDLOOP;

	IF freeSizes THEN FreeSizes[sizes];
	listDir←prevdir;

	END;

-- top level size routines

GetSizes: PROCEDURE[p: BoxNodePtr] RETURNS[sizes: DDArray]=
	BEGIN
	head: NodePtr ← p.head;
	flex: ARRAY FlexDir OF Flex;
	size, err: DDimn;
	children: CARDINAL;

	-- count the children that have sizes to remember
	children←CountItems[head];
	IF children=0 THEN RETURN[DESCRIPTOR[NIL,0]];

	-- allocate the array to hold the sizes
	sizes←DESCRIPTOR[
		TexMemDefs.AllocMem[SIZE[DDimn]*children],children];

	-- calculate and save the natural sizes; save max flex info
	[flex,size]←NaturalSizes[head,sizes];

	-- decide whether to stretch or shrink
	SELECT err←RS[BoxSize[p]]-size FROM
		>0 => StretchSizes[head,sizes,err,
					flex[str].val,flex[str].order];
		<0 => IF NOT
				(p.glueset.dir=shr AND p.glueset.order=regular AND
					p.glueset.num=p.glueset.den) THEN -- not an overfull box
					ShrinkSizes[head,sizes,-err,flex[shr].val,flex[shr].order]
				ELSE IF DEBUG THEN TexIODefs.Ps["<Overfull box on display>"];
		ENDCASE => NULL; -- no flex needed; just use natural widths

	END;

FreeSizes: PROCEDURE[sizes:DDArray] =
	BEGIN
	children: CARDINAL←LENGTH[sizes];
	IF children>0 THEN
		TexMemDefs.FreeMem[BASE[sizes],SIZE[DDimn]*children];
	END;

CountItems: PROCEDURE[list:NodePtr] RETURNS[n:CARDINAL] =
	BEGIN -- count char, box, rule, space, kern, glue nodes
	n←0;
	WHILE list#NIL DO
		WITH pp:list SELECT FROM
			char, box, rule, space, kern, glue => n←n+1;
			string => n←n+pp.length;
			-- don't count leader; it's covered by following glue node
			ENDCASE => NULL;
		list←list.link;
		ENDLOOP;
	END;

GlueShrink: PROCEDURE[g: GluePtr] RETURNS[shrink: Dimn] =
	BEGIN -- increase nonzero shrink for display
	minSpaceSize: INTEGER=micasPerDot;
	IF (shrink←g.flex[shr].val)#0 THEN
		shrink←MAX[shrink,MIN[g.space/2,g.space-minSpaceSize]];
	-- on display, allow glue to shrink to 1/2 space
		-- if that is at least minSpaceSize
	-- unless specified shrink is even greater.
	-- this keeps proportional spacing where possible
	-- while making sure that spaces don't vanish (unless scaling down)
	END;

NaturalSizes: PROCEDURE[list: NodePtr, sizes: DDArray]
		RETURNS[flex: ARRAY FlexDir OF Flex, size: DDimn] =
	BEGIN
	-- calculate and save the natural sizes
	-- return max nonzero flex orders, unscaled flexibility, and total size
	nchild: CARDINAL;
	c: DDimn;
	ord: FlexOrder;
	val: Dimn;
	stretch: FlexVec ← [0,0,0];
	shrink: FlexVec ← [0,0,0];
	nchild←0; size←0;
	WHILE list#NIL DO
		BEGIN
		WITH q:list SELECT FROM
			char => c←CharacterDisplaySize[q.c];
			string =>
				BEGIN
				i: INTEGER;
				f: Font←q.font;
				ch: FChar;
				FOR i IN[0..q.length)
					DO
					ch←[f,q.text[i]];
					size←size+(sizes[nchild]←CharacterDisplaySize[ch]);
					nchild←nchild+1;
					ENDLOOP;
				GOTO Done;
				END;
			box => c←RS[BoxSize[@q]];
			rule => c←RS[RuleSize[@q]];
			space => c←RS[q.s];
			kern => c←RoundDown[Scale[q.s]];
			glue =>
				BEGIN
				g: GluePtr ← q.g;
				gflex: Flex;
				space: Dimn←g.space;
				c←RS[space];
				-- stretch
				gflex←g.flex[str];
				stretch[gflex.order]←stretch[gflex.order]+gflex.val;
				-- shrink
				gflex←g.flex[shr];
				shrink[gflex.order]←shrink[gflex.order]+GlueShrink[g];
				END;
			ENDCASE => BEGIN list←list.link; LOOP; END;
		size←size+(sizes[nchild]←c); nchild←nchild+1;
		EXITS Done => NULL END;
		list←list.link;
		ENDLOOP;
	flex←[zeroFlex,zeroFlex];
	FOR ord DECREASING IN FlexOrder DO
		IF (val←stretch[ord])#0 THEN
			BEGIN flex[str]←[ord,val]; EXIT; END;
		ENDLOOP;
	FOR ord DECREASING IN FlexOrder DO
		IF (val←shrink[ord])#0 THEN
			BEGIN flex[shr]←[ord,val]; EXIT; END;
		ENDLOOP;
	END;

BoxSize: PROCEDURE [p: BoxNodePtr] RETURNS[Dimn] = INLINE
	BEGIN
	RETURN [IF listDir=vlist THEN p.height+p.depth ELSE p.width];
	END;

RuleSize: PROCEDURE [p: POINTER TO rule Node] RETURNS[Dimn] = INLINE
	BEGIN
	RETURN [IF listDir=vlist THEN p.height+p.depth ELSE p.width];
	END;

CharacterDisplaySize: PROCEDURE[c: FChar] RETURNS[DDimn] = INLINE
	BEGIN
	RETURN [IF listDir=vlist THEN
					CharacterDisplayHeight[c]+CharacterDisplayDepth[c]
				ELSE CharacterDisplayWidth[c]];
	END;

-- stretch routines

StretchSizes: PROCEDURE[
		head: NodePtr,
		sizes: DDArray,
		err: DDimn,
		flex: Dimn,
		maxstretch: FlexOrder] =
	BEGIN
	qq: NodePtr;
	old, new: DDimn;
	nchild: CARDINAL;

	IF DEBUG THEN
		BEGIN OPEN TexIODefs;
		UseDisplay;
		Ps["<+box "];
		Wn[InlineDefs.LowHalf[err/micasPerDot]];
		Ws[">"];
		END;

	IF flex=0 THEN BEGIN StretchNonGlue[head,sizes,err]; RETURN END;

	-- store the stretched glue sizes 
	qq←head; nchild←0;
	DO -- reduce the error and the flexibility each time stretch some glue
		WITH q:qq SELECT FROM
		char, box, rule, space, kern => nchild←nchild+1;
		string => nchild←nchild+q.length;
		glue =>
			BEGIN
			IF q.g.flex[str].order = maxstretch THEN
				BEGIN
				old←sizes[nchild];
				sizes[nchild]←new←Round[StretchGlue[q.g,err,flex]];
				err←err+old-new;
				IF (flex←flex-q.g.flex[str].val)=0 THEN
					-- this is the last glue
					BEGIN
					sizes[nchild]←sizes[nchild]+err;
					IF DEBUG THEN ReportFlex[str,new-old+err];
					EXIT
					END;
				IF DEBUG THEN ReportFlex[str,new-old];
				END;
			nchild←nchild+1;
			END;
		ENDCASE => NULL;
		qq←qq.link;
		ENDLOOP;

	END;

StretchNonGlue: PROCEDURE[head: NodePtr, sizes: DDArray, err: DDimn] =
	BEGIN
	-- stretch the char, box, and rule children evenly by total amount=err
	-- effect is to add white space after each
	-- don't stretch last child (so end of box looks okay)
	-- don't change kerning amounts
	-- don't change glue (usually won't be any in the list)
	nchild: CARDINAL;
	qq: NodePtr;
	nstretch,n: CARDINAL;
	r0, r1, diff, x, stretch: DDimn;
	StretchSize: PROCEDURE[i: CARDINAL] =
		BEGIN
		r1←RoundDown[(x←x+err)/nstretch];
		IF (diff←r1-r0) # 0 THEN
			BEGIN
			sizes[i]←sizes[i]+diff; stretch←stretch+diff;
			r0←r1;
			END;
		END;
	-- count number of children to stretch
	qq←head;
	nstretch←0;
	WHILE qq#NIL DO
		WITH q:qq SELECT FROM
			char, box, rule => nstretch←nstretch+1;
			string => nstretch←nstretch+q.length;
			ENDCASE => NULL;
		qq←qq.link;
		ENDLOOP;
	IF nstretch<=1 THEN RETURN; -- nothing in list to stretch (?!)
	nstretch←nstretch-1; -- don't want to stretch last child

	-- distribute the stretch evenly
	qq←head; nchild←0; r0←RoundDown[(x←err)/nstretch]; stretch←0; n←0;
	WHILE n<nstretch DO
		WITH q:qq SELECT FROM
		space, kern, glue => nchild←nchild+1;
		char, box, rule =>
			BEGIN StretchSize[nchild]; nchild←nchild+1; n←n+1 END;
		string => THROUGH [0..q.length) WHILE n<nstretch
			DO StretchSize[nchild]; nchild←nchild+1; n←n+1 ENDLOOP;
		ENDCASE => NULL;
		qq←qq.link;
		ENDLOOP;
	IF stretch#err THEN ERROR; -- should have exact fit by now
	IF DEBUG THEN
		BEGIN OPEN TexIODefs;
		UseDisplay;
		Ws["<Stretch nonglue "];
		Wn[InlineDefs.LowHalf[stretch/micasPerDot]];
		Ws[" dots over "];
		Wn[nstretch];
		Ws[" items>"];
		END;
	END;

StretchGlue: PROCEDURE[g:GluePtr, err:DDimn, flex:Dimn] RETURNS[DDimn] = INLINE
	BEGIN -- err is scaled, flex is not
	RETURN [Scale[g.space]+(g.flex[str].val*err)/flex];
	END;

-- shrink routines

ShrinkSizes: PROCEDURE[
		head: NodePtr,
		sizes: DDArray,
		err: DDimn,
		flex: Dimn,
		maxshrink: FlexOrder] =
	BEGIN
	-- err is the (scaled, positive) amount by which to shrink sizes
	-- flex is the (unscaled, positive) amount by which glue can shrink
	qq: NodePtr;
	old, new, shrinkchars, scaledflex, vshrink: DDimn;
	nchild: CARDINAL;

	IF DEBUG THEN
		BEGIN OPEN TexIODefs;
		UseDisplay;
		Ps["<-box "];
		Wn[InlineDefs.LowHalf[err/micasPerDot]];
		Ws[">"];
		END;

	shrinkchars←err-(scaledflex←RS[flex]);
	IF shrinkcharsEnabled
	 AND maxshrink=regular AND shrinkchars>0 THEN -- glue can't shrink enough
		BEGIN -- shrink chars and lower error goal so don't overshrink
		rem: DDimn ← ShrinkChars[head,sizes,shrinkchars,scaledflex];
		err←scaledflex;
		IF rem<0 THEN err←err+rem; -- overshot in shrinking the chars
		END;
	IF flex=0 THEN RETURN;

	-- store the shrunken glue sizes 
	IF listDir=vlist THEN -- decide how much to shrink each glue
		-- for vlist, want same spacing (leading); ok to overshrink a little
		-- in hlist can have different width spaces; want final err=0
		BEGIN
		num: CARDINAL←0; -- total number of maxshrink glue nodes
		qq←head; nchild←0;
		UNTIL qq=NIL DO
			WITH q:qq SELECT FROM
				glue => IF q.g.flex[shr].order = maxshrink THEN num←num+1;
				ENDCASE => NULL;
			qq←qq.link;
			ENDLOOP;
		IF num=0 THEN ERROR;
		vshrink ← (err+num-1)/num;
		END;
	qq←head; nchild←0;
	UNTIL qq=NIL DO
		WITH q:qq SELECT FROM
		char, box, rule, space, kern => nchild←nchild+1;
		string => nchild←nchild+q.length;
		glue =>
			BEGIN
			IF q.g.flex[shr].order = maxshrink THEN
				BEGIN
				old←sizes[nchild];
				IF listDir=hlist THEN
					BEGIN
					-- reduce the error and the flexibility
						-- each time shrink some glue
					shrink: Dimn ← GlueShrink[q.g];
					sizes[nchild]←new←Round[ShrinkGlue[q.g,err,shrink,flex]];
					err←err-old+new;
					IF (flex←flex-shrink)=0 THEN
						-- this is the last glue
						BEGIN
						sizes[nchild]←sizes[nchild]-err;
						IF DEBUG THEN ReportFlex[shr,old-new+err];
						EXIT
						END;
					END
				ELSE
					BEGIN
					sizes[nchild]←new←old-vshrink;
					err←err-old+new;
					END;
				IF DEBUG THEN ReportFlex[shr,old-new];
				END;
			nchild←nchild+1;
			END;
		ENDCASE => NULL;
		qq←qq.link;
		ENDLOOP;

	END;

ShrinkChars: PROCEDURE[head: NodePtr, sizes: DDArray, err, glueflex: DDimn]
		RETURNS[DDimn] =
	BEGIN
	-- shrink selected nodes by total of err
	-- okay to overshoot err by as much as glueflex, but minimize overshoot
	-- return err-actual shrink; may be negative if overshoot
	-- sequences consist of chars, boxes, and kern nodes
	-- include boxes because might hold an accented character
	-- include kern nodes because want uniform spacing in words with kerning
	-- shrink longer sequences in preference to shorter ones
	-- minimize variance in shrink between sequences and within them
	-- never shrink by more than node's width so don't get neg width
	nchild, nshrink: CARDINAL;
	num: INTEGER;
	q: NodePtr;
	remaining, cs, shrink, target: DDimn;
	ShrinkNode: TYPE = RECORD
		[ -- have one of these per sequence of chars to shrink
		link: ShrinkPtr, -- points to next ShrinkNode
		node: NodePtr, -- points to first node in the sequence
		nchild: CARDINAL, -- sizes index for the first node in sequence
		num: CARDINAL, -- number of nodes to shrink in this sequence
		sz: DDimn, -- total size of this sequence
		minsz: DDimn, -- size of smallest node to shrink in this sequence
		done: BOOLEAN -- starts FALSE, set TRUE when shrink this sequence
		];
	ShrinkPtr: TYPE = POINTER TO ShrinkNode;
	shrinklist,shrinknode: ShrinkPtr ← NIL;
	AllocShrinkNode: PROCEDURE RETURNS[p: ShrinkPtr] = INLINE
		BEGIN RETURN[TexMemDefs.AllocMem[SIZE[ShrinkNode]]]; END;
	FreeShrinkNode: PROCEDURE[p: ShrinkPtr] = INLINE
		BEGIN TexMemDefs.FreeMem[p,SIZE[ShrinkNode]]; END;
	FreeShrinkList: PROCEDURE = INLINE
		BEGIN
		WHILE shrinklist#NIL DO
			shrinknode←shrinklist.link;
			FreeShrinkNode[shrinklist];
			shrinklist←shrinknode;
			ENDLOOP;
		END;
	FindLongest: PROCEDURE RETURNS [ShrinkPtr] = INLINE
		BEGIN
		longest, list: ShrinkPtr;
		sz: DDimn; -- sz for current longest
		longest←NIL; sz←0; list←shrinklist;
		WHILE list#NIL DO
			IF list.done=FALSE AND list.sz>sz THEN
				BEGIN longest←list; sz←list.sz; END;
			list←list.link;
			ENDLOOP;
		IF longest#NIL THEN longest.done←TRUE;
		RETURN [longest];
		END;
	first: BOOLEAN←TRUE;
	StartShrinkNode: PROCEDURE[node: NodePtr, nchild: CARDINAL] =
		BEGIN
		shrinknode←AllocShrinkNode[];
		shrinknode↑←[shrinklist,node,nchild,0,0,LAST[DDimn],FALSE];
		shrinklist←shrinknode;
		first←FALSE;
		END;
	UpdateShrinkNode: PROCEDURE[size: DDimn] =
		BEGIN
		nshrink←nshrink+1; cs←MIN[cs,size];
		shrinknode.num←shrinknode.num+1;
		shrinknode.minsz←MIN[shrinknode.minsz,size];
		shrinknode.sz←shrinknode.sz+size;
		END;
	LookAhead: PROCEDURE[q: NodePtr, nchild: CARDINAL] =
		BEGIN
		size: DDimn←sizes[nchild];
		nxtchild: CARDINAL ← nchild+1;
		nxt: NodePtr←q.link; -- pointer to following node(s)
		WHILE nxt#NIL DO
			WITH nxt SELECT FROM
				glue, space, rule => EXIT; -- end of sequence
				kern => size←size+sizes[nxtchild]; -- adjust for kerning
				char, box, string =>
					BEGIN
					IF first THEN StartShrinkNode[q,nchild];
					UpdateShrinkNode[size];
					EXIT;
					END;
				ENDCASE => NULL;
			nxt←nxt.link; nxtchild←nxtchild+1;
			ENDLOOP;
		RETURN;
		END;
	ApplyShrink: PROCEDURE[shrinknode: ShrinkPtr, shrink: DDimn] =
		BEGIN
		q: NodePtr;
		nchild: CARDINAL←shrinknode.nchild;
		i: CARDINAL←shrinknode.num;
		ShrinkOne: PROCEDURE =
			BEGIN
			sizes[nchild]←sizes[nchild]-shrink;
			i←i-1; nchild←nchild+1;
			END;
		FOR q←shrinknode.node,q.link UNTIL q=NIL OR i=0
			DO
			WITH qq:q SELECT FROM
				char, box => ShrinkOne;
				string => THROUGH[0..qq.length) WHILE i>0 DO ShrinkOne ENDLOOP;
				kern => nchild←nchild+1;
				ENDCASE => NULL;
			ENDLOOP;
		END;
	Report: PROCEDURE [nchild, num: CARDINAL, cs: DDimn] =
		BEGIN OPEN TexIODefs;
		Ws["<- "];
		PrintSequence[head,nchild,num];
		IF cs>micasPerDot THEN
			BEGIN
			Ws[" "];
			Wn[InlineDefs.LowHalf[cs/micasPerDot]];
			END;
		Wc['>];
		END;

	remaining←err; -- decrement this as reduce sizes

	-- create shrinklist, set nshrink←SUM of num's; set cs←MIN of minsz's
	q←head; nchild←0; nshrink←0; first←TRUE; cs←LAST[DDimn];
	WHILE q#NIL DO
		WITH qq:q SELECT FROM
		glue, space, rule => -- these break a sequence
			BEGIN nchild←nchild+1; first←TRUE; END;
		kern => nchild←nchild+1; -- these can be imbedded inside a sequence
		char, box => -- these can be part of a sequence
			BEGIN LookAhead[q,nchild]; nchild←nchild+1 END;
		string => -- so can these
			BEGIN
			len: StringLength←qq.length;
			IF len>1 THEN
				BEGIN
				IF first THEN StartShrinkNode[q,nchild];
				THROUGH[0..len-1) -- for all but the last character
					DO UpdateShrinkNode[sizes[nchild]]; nchild←nchild+1 ENDLOOP;
				END;
			LookAhead[q,nchild]; nchild←nchild+1; -- for the last character
			END;
		ENDCASE => NULL;
		q←q.link;
		ENDLOOP;
	IF nshrink=0 THEN RETURN[err];

	-- first try to do uniform shrink across entire list
	IF (shrink←MIN[cs,RoundDown[err/nshrink]])<cs -- can still increase shrink
		AND nshrink*(target←RoundUp[shrink+1])<=err+(glueflex/3)
			-- allow shrink beyond err, but don't overshoot by more
			-- than 1/3 glueflex, else get overshrunk chars.
		THEN shrink←target;
	IF shrink>0 THEN
		BEGIN
		FOR shrinknode←shrinklist,shrinknode.link WHILE shrinknode#NIL
			DO
			ApplyShrink[shrinknode,shrink];
			shrinknode.minsz←shrinknode.minsz-shrink;
			ENDLOOP;
		IF DEBUG THEN
			BEGIN OPEN TexIODefs;
			Ws["<-"];
			Wn[nshrink];
			IF shrink>micasPerDot THEN
				BEGIN
				Wc['*];
				Wn[InlineDefs.LowHalf[shrink/micasPerDot]];
				END;
			Wc['>];
			END;
		IF (remaining←remaining-nshrink*shrink)<=0 THEN
			BEGIN FreeShrinkList[]; RETURN[remaining]; END;
		END;

	-- distribute the error keeping shrink within a sequence uniform 
		-- don't sort list since usually only shrink a few sequences
	target←RoundUp[remaining/nshrink]; -- want to shrink by this
	WHILE remaining>0 AND (shrinknode←FindLongest[])#NIL DO
		num←shrinknode.num;
		cs←MIN[target,shrinknode.minsz,RoundDown[(remaining+glueflex)/num]];
			-- don't shrink by more than target
			-- don't have shrink in this sequence > minsz
			-- don't overshoot remaining+glueflex
		IF cs>0 THEN
			BEGIN
			ApplyShrink[shrinknode,cs];
			remaining←remaining-num*cs;
			IF DEBUG THEN Report[shrinknode.nchild,num,cs];
			END;
		ENDLOOP;
	-- give up now, even if that's not enough shrinking
	FreeShrinkList[];
	RETURN [remaining];
	END;

ShrinkGlue: PROCEDURE[g:GluePtr, err:DDimn, shrink,flex:Dimn] RETURNS[DDimn] = INLINE
	BEGIN -- err is scaled, flex and shrink are not
	RETURN [Scale[g.space]-(shrink*err)/flex];
	END;


-- character size information

CharacterDisplayHeight: PROCEDURE [c: FChar] RETURNS[DDimn] = 
	BEGIN
	RETURN [RS[TexFontDefs.CharHt[c]]];
	END;

CharacterDisplayWidth: PROCEDURE [c: FChar] RETURNS[DDimn] = 
	BEGIN
	font: DisplayFont ← displayFonts[--c.font-- 0 --for now only one font--];
	xarray: POINTER TO ARRAY [0..0) OF CARDINAL ← font.strike.xInSegment;
	char: CARDINAL ← LOOPHOLE[c.char,CARDINAL];
	w: CARDINAL ← xarray[char+1]-xarray[char];
	IF font.mode = XGraphicsDefs.bold THEN w←w+1;
	RETURN [DotsToDDimn[w]];
	END;

DotsToDDimn: PROCEDURE [dots: CARDINAL] RETURNS[DDimn] = INLINE
	BEGIN
	RETURN [dots*micasPerDot];
	END;

CharacterDisplayDepth: PROCEDURE [c: FChar] RETURNS[DDimn] = 
	BEGIN
	RETURN [RS[TexFontDefs.CharDp[c]]];
	END;

Strike: PROCEDURE [c: FChar] RETURNS[POINTER TO XGraphicsDefs.StrikeFont] = INLINE
	BEGIN
	RETURN [displayFonts[--c.font-- 0 --for now only one font--].strike];
	END;

-- routines that actually put bits on the screen

DisplayCharacter: PROCEDURE [c: FChar, x, y: DDimn] =
	BEGIN
	-- x,y are scaled and rounded left,baseline for character
	-- takes care of synthetic italic and boldface
	font: DisplayFont ← displayFonts[--c.font-- 0 --for now only one font--];

	-- for now, skip character if not fully on screen rather than clip
	IF x < screenLeft THEN RETURN;
	IF (x+CharacterDisplayWidth[c]) > screenRight THEN RETURN;
	IF (y-CharacterDisplayHeight[c]) < screenTop THEN RETURN;
	IF (y+CharacterDisplayDepth[c]) > screenBottom THEN RETURN;

	charString[0]←c.char;
	[]←XGraphicsDefs.PutTextInBitmap[charString, DotNum[x], DotNum[y],
						font.strike, font.mode, bitMap];
	END;

DisplayRectangle: PROCEDURE [x, y, h, w: DDimn] =
	BEGIN
	-- x,y,h,w are scaled and rounded left,top,height,width
	x1, x2, y1, y2: DDimn;
	x1 ← MAX[screenLeft,x];
	x2 ← MIN[screenRight,x+w];
	y1 ← MAX[screenTop,y];
	y2 ← MIN[screenBottom,y+h];
	IF x1>=x2 OR y1>=y2 THEN RETURN;
	XGraphicsDefs.PutAreaInBitmap[DotNum[x1], DotNum[y1], DotNum[x2]-1,
						DotNum[y2]-1, bitMap];
	END;

DotNum: PROCEDURE[d: DDimn] RETURNS[CARDINAL] = INLINE
	BEGIN -- doesn't check for dimension out of range
	RETURN [InlineDefs.LowHalf[d]/micasPerDot];
	END;

-- miscellaneous routines used in debugging

PrintSequence: PROCEDURE [head: NodePtr, first,num: CARDINAL] =
	BEGIN
	i: CARDINAL;
	FOR i IN [first..first+num] DO PrintChar[head,i]; ENDLOOP;
	END;

PrintChar: PROCEDURE [head: NodePtr, nchild: CARDINAL] =
	BEGIN
	WHILE head#NIL DO
		WITH p:head SELECT FROM
			glue, space, kern, box, rule => nchild←nchild-1;
			char =>
				IF nchild=0 THEN -- this is it
					BEGIN TexIODefs.Wc[p.c.char]; RETURN; END
				ELSE nchild←nchild-1;
			ENDCASE;
		head←head.link;
		ENDLOOP;
	END;

ReportFlex: PROCEDURE [dir: FlexDir, amount: DDimn] =
	BEGIN OPEN TexIODefs;
	Ws[IF dir=shr THEN "<-g " ELSE "<+g "];
	Wn[InlineDefs.LowHalf[amount/micasPerDot]];
	Ws[">"];
	END;

AllocDisplayFonts: PROCEDURE[numfonts: CARDINAL]
	RETURNS[dispfonts: DisplayFonts] = INLINE
	BEGIN
	dispfonts←DESCRIPTOR[
		TexMemDefs.AllocMem[SIZE[TexDispDefs.DisplayFont]*numfonts],
		numfonts];
	END;
FreeDisplayFonts: PROCEDURE[dispfonts: DisplayFonts] = INLINE
	BEGIN
	TexMemDefs.FreeMem[BASE[dispfonts],
		SIZE[TexDispDefs.DisplayFont]*LENGTH[dispfonts]];
	END;

setup: BOOLEAN←TRUE;

SetUpDisplay: PUBLIC PROCEDURE =
	BEGIN
	DCBHead: POINTER TO CARDINAL = LOOPHOLE[420B];
	nextDCB: POINTER TO ARRAY[0..3] OF CARDINAL ← LOOPHOLE[DCBHead↑];
	DCBtop: POINTER TO ARRAY [0..3] OF CARDINAL ← nextDCB;
	nScanLines: CARDINAL ← 608;
	
--	UNTIL nextDCB[0] = 0 DO
--	nScanLines ← nScanLines - nextDCB[3]*2;
--	nextDCB ← LOOPHOLE[nextDCB[0]];
--	ENDLOOP;
--	nScanLines ← nScanLines - nextDCB[3]*2;
	
--	IF nScanLines<=0 THEN nScanLines←1;
	XGraphicsDefs.SetDefaultBitmap[608,nScanLines];
	[] ← XGraphicsDefs.TurnOnGraphics[];
	nextDCB ← LOOPHOLE[DCBHead↑];
	nextDCB[0] ← LOOPHOLE[DCBtop,CARDINAL];
	setup←FALSE;
	END;

InitDisp: PUBLIC PROCEDURE =
	BEGIN
	IF setup THEN SetUpDisplay;
	-- allocate display font array
	displayFonts←AllocDisplayFonts[nFonts];
	END;

CloseDisp: PUBLIC PROCEDURE =
	BEGIN
	-- deallocate
	FreeDisplayFonts[displayFonts];
	END;

END.