-- TexVMode.mesa

-- last written by Doug Wyatt, December 5, 1979  2:54 PM

DIRECTORY
	TexAlignDefs: FROM "TexAlignDefs",
	TexDefs: FROM "TexDefs",
	TexErrorDefs: FROM "TexErrorDefs",
	TexGlueDefs: FROM "TexGlueDefs",
	TexIODefs: FROM "TexIODefs",
	TexJustifyDefs: FROM "TexJustifyDefs",
	TexMainDefs: FROM "TexMainDefs",
	TexNodeDefs: FROM "TexNodeDefs",
	TexPackDefs: FROM "TexPackDefs",
	TexSynDefs: FROM "TexSynDefs",
	TexTableDefs: FROM "TexTableDefs",
	TexTokenDefs: FROM "TexTokenDefs";

TexVMode: PROGRAM
IMPORTS TexAlignDefs,TexErrorDefs,TexGlueDefs,TexIODefs,TexJustifyDefs,
	TexMainDefs,TexNodeDefs,TexPackDefs,TexSynDefs,TexTableDefs,TexTokenDefs
EXPORTS TexMainDefs =
BEGIN OPEN TexMainDefs,TexTableDefs,TexNodeDefs,TexSynDefs,TexDefs;

-- *****************
-- * Vertical mode *
-- *****************

VAppend: PUBLIC PROCEDURE[vh: VHeadPtr, b: BoxNodePtr] =
	BEGIN OPEN vh;
	-- append a box node to the current vlist
	-- the inter-line glue is also appended between boxes
	IF prevdepth#pflag THEN
		BEGIN OPEN TexGlueDefs;
		-- appending to a vlist with previous depth prevdepth
		p: GluePtr←GlueParam[baselineskip];
		q: GluePtr←InterLineGlue[p.space-prevdepth-b.height, p];
		StoreNode[vlist, MakeGlueNode[q]]; -- append the glue
		END;
	StoreNode[vlist, b]; -- append the box
	prevdepth←b.depth; -- and remember its depth
	END;

VMode: PUBLIC PROCEDURE[vhead: VHeadPtr, restricted: BOOLEAN] =
	BEGIN OPEN vhead;
	CheckPriv: PROCEDURE = BEGIN IF restricted THEN SIGNAL FallThru END;
	Store: PROCEDURE[p: NodePtr] =
		BEGIN StoreNode[vlist, p] END;
	Append: PROCEDURE[b: BoxNodePtr] = INLINE
		BEGIN VAppend[vhead,b]; END;
	nlines,l: CARDINAL;
	begin: CARDINAL; width0,width1,indent0,indent1: Dimn;
	LineWidth: TexJustifyDefs.LineWidthProc =
		BEGIN RETURN[IF (nlines+line)<begin THEN width0 ELSE width1] END;
	LineIndent: TexJustifyDefs.LineWidthProc =
		BEGIN RETURN[IF (nlines+line)<begin THEN indent0 ELSE indent1] END;
	-- Note: FinishParagraph destroys hlist's listhead!
	FinishParagraph: PROCEDURE[hlist: NodeListPtr, penalt: BOOLEAN]
		RETURNS[lastwidth: Dimn] =
		BEGIN OPEN TexGlueDefs,TexJustifyDefs;
		parfillglue: GluePtr←CommonGlue[fil];
		wPen: Penalty←CurPenalty[wpen]; bPen: Penalty←CurPenalty[bpen];
		NewLine: NewLineProc =
			BEGIN OPEN info;
			-- justification by the page builder: insert the topinsert, botinsert,
			-- and eject nodes removed from the line by hpackaging, then check if
			-- there is any special penalty for breaking after this line
			pen: Penalty←0;
			linebox.shiftamt←LineIndent[l];
			Append[linebox]; l←l+1; -- append the line
			AppendNodeList[vlist,inserts]; -- append any inserts
			IF widow AND (first OR penalt) THEN pen←pen+wPen; -- widow penalty
			IF broken THEN pen←pen+bPen; -- broken line penalty
			IF pen#0 THEN Store[MakePenaltyNode[pen]];
			END;
		WITH pp:hlist.last SELECT FROM
			glue => BEGIN DelGlueLink[pp.g]; pp.g←parfillglue END;
			ENDCASE => StoreNode[hlist,MakeGlueNode[parfillglue]];
		l←0;
		lastwidth←Justification[hlist, LineWidth, NewLine];
		nlines←nlines+l;
		RETURN[lastwidth];
		END;
	AppendDisplay: PROCEDURE[abovedisplaywidth: Dimn] =
		BEGIN OPEN TexPackDefs,TexGlueDefs;
		dlist: NodeListPtr←InitNodeList[];
		b,eqnobox: BoxNodePtr; -- boxes containing the equation and eqno
		inserts: NodeListPtr←InitNodeList[];
		flexsums: FlexSums; -- flex totals for the equation
		shr: Flex;
		w: Dimn; -- width of the equation
		dw: Dimn; -- desired line width
		nw: Dimn; -- width of equation number to append to the equation
		lmar: Dimn; -- width of left indent
		shift: Dimn; -- amount to shift equation right for centering
		quad: Dimn; -- quad width for current math fonts
		qd: Dimn; -- space for equation number plus quad width
		q1,q2: GluePtr; -- pointers to glue spec for above and below
		singleline: BOOLEAN←TRUE;
		CanShrink: PROCEDURE[shr: Flex, w: Dimn] RETURNS[BOOLEAN] = --INLINE--
			BEGIN
			RETURN[FALSE]; -- ***** fix this *****
			END;
		RePack: PROCEDURE[b: BoxNodePtr, w: Dimn] RETURNS[BoxNodePtr] =
			BEGIN
			list: NodeListPtr←MakeNodeList[b.head];
			b.head←NIL; DsNode[b]; RETURN[HPack[list,w]];
			END;

		eqnobox←GetDisplay[dlist]; -- scan a formula in display MMode
		quad←MathQuad[];
		-- ignore empty display (probably was $$\halign{...}$$)
		IF dlist.link=NIL THEN BEGIN FreeNodeList[dlist]; RETURN END;
	
		b←HPackage[dlist,0,TRUE,inserts,@flexsums];
		FreeNodeList[inserts];
		w←b.width; -- determine the equations's natural width
		shr←DominantFlex[@flexsums[shr]]; -- remember total shrink
		lmar←LineIndent[0]; dw←LineWidth[0];
		IF eqnobox=NIL THEN nw←qd←0
		ELSE BEGIN nw←eqnobox.width; qd←nw+quad END;
		IF (w+qd)>dw THEN
			BEGIN -- the equation doesn't fit with its natural width
			-- we will squeeze it as best we can
			IF CanShrink[shr, w+qd-dw] THEN
				b←RePack[b, dw-qd] -- it will fit on one line
			ELSE
				BEGIN -- too big, drop equation number to separate line
				singleline←FALSE; IF w>dw THEN b←RePack[b, dw];
				END;
			END;
		w←b.width;
		-- now we have an equation b of width w and a possible equation number
		-- eqnobox of width nw, and they are to be centered appropriately on a
		-- line of width dw. (If NOT singleline, the equation number will appear
		-- on a separate line below the display)
		nlines←nlines+3; -- treat as three lines output w.r.t. hanging indents
		shift←(dw-w)/2; -- prepare to center the equation on the line
		IF singleline AND shift<2*nw THEN shift←0; -- but put it flush left if
			-- centering would make it too close to the equation number
		-- At this point shift will be negative if the equation is too large;
		-- it will extend into the margins
		IF shift+lmar<=abovedisplaywidth THEN
			BEGIN -- for large formulas use dispskip glue above and below
			q1←q2←GlueParam[dispskip];
			END
		ELSE
			BEGIN -- otherwise use dispaskip, dispbskip and delete a virtual line
			nlines←nlines-1;
			q1←GlueParam[dispaskip]; q2←GlueParam[dispbskip];
			END;
		Store[MakeGlueNode[q1]];
		IF singleline THEN
			BEGIN -- attach equation number
			hlist: NodeListPtr←InitNodeList[];
			StoreNode[hlist, b];
			StoreNode[hlist, MakeGlueNode[CommonGlue[fill]]];
			StoreNode[hlist, eqnobox];
			b←HPack[hlist, dw-shift]; -- eqno will be right-justified
			END;
		b.shiftamt←shift+lmar;
		Append[b];
		IF singleline THEN Store[MakeGlueNode[q2]] -- put chosen glue after display
		ELSE
			BEGIN -- append the equation number on a separate line
			eqnobox.shiftamt←lmar+dw-eqnobox.width;
			Store[MakePenaltyNode[maxPenalty]]; -- no break may occur here
			Append[eqnobox];
			END;
		END;
	
	DO
	GetNext[];
	BEGIN
	ENABLE
		BEGIN
		FallThru => BEGIN SIGNAL CantDoThat[v, restricted]; CONTINUE END;
		Reswitch => RETRY;
		Continue => CONTINUE;
		END;
	WITH cc:curchar SELECT curcmd FROM

	lbrace => NewSaveLevel[simpleblock];

	rbrace => SELECT SaveCode[] FROM
		simpleblock => UnSave[simpleblock]; -- just pop the savestack
		trueend => TrueEnd[]; -- skip over the \else part
		falseend => FalseEnd[]; -- skip over a spacer, if any
		bottomlevel => TexErrorDefs.Error["Too many }'s"];
		alignentry,noalignend => EXIT; -- let the alignment handle this
		outputend => RETURN; -- end of \output routine
		topinsend,botinsend => RETURN; -- end of insertion
		endvcenter => RETURN; -- end of \vcenter or \vtop
		justend => RETURN; -- end of \vbox
		aligncode,mathcode,mathleft,mathblock,endscanmath =>
			ERROR TexErrorDefs.Confusion; -- invalid endcode in VMode
		ENDCASE => ERROR; -- bad EndingCode

	mathbr,letter,otherchar,ascii,noindent,accent,nonmathletter,caseshift =>
		BEGIN
		hlist: NodeListPtr←InitNodeList[];
		hhead: HHead;
		abovedisplaywidth: Dimn;
		CheckPriv; -- beginning of a paragraph, must be in the page builder
		Store[MakeGlueNode[GlueParam[parskip]]]; -- inter-paragraph glue
		IF curcmd#noindent THEN
			BEGIN
			BackInput; -- put it back for HMode to scan
			StoreNode[hlist, IndentBox[DimnParam[parindent]]];
			END;
		nlines←0;
			DO
			hhead←[hlist,sfOne];
			HMode[@hhead, FALSE]; -- call the paragraph builder
			-- get current hangindent and hsize
			-- (they might have been changed by HMode)
			[begin,width0,width1,indent0,indent1]←
				HangVals[GlobalHangIndent[],DimnParam[hsize]];
			SELECT curcmd FROM
				parend => EXIT; -- end of the paragraph
				mathbr => NULL; -- paragraph interrupted by math display
				ENDCASE => SIGNAL TexErrorDefs.Confusion;
			IF hlist.link=NIL THEN abovedisplaywidth←LAST[Dimn]
			ELSE -- output the paragraph so far
				BEGIN
				lastwidth: Dimn←FinishParagraph[hlist,FALSE];
				abovedisplaywidth←lastwidth+2*MathQuad[];
				hlist←InitNodeList[];
				Store[MakePenaltyNode[CurPenalty[disppen]]]; -- penalty for break
				END;
			AppendDisplay[abovedisplaywidth];
			-- ignore space after closing $$
			GetNCTok; IF curcmd#spacer THEN BackInput;
			ENDLOOP;
		[]←FinishParagraph[hlist,TRUE];
		SetGlobalHangIndent[nullHang]; -- reset hanging indent
		END;

	tabmrk,carret => BEGIN CheckAlignment; SIGNAL TexErrorDefs.Confusion END;

	spacer,parend => NULL; -- ignore these in vmode

	endv =>
		BEGIN
		CheckAlignment;
		IF SaveCode[]=alignentry THEN EXIT
		ELSE MissingBrace; -- will SIGNAL Reswitch
		END;

	font => SetFont[ScanFont[]];

	innput => InputFile[];

	stop =>
		BEGIN
		lev: Lev;
		CheckPriv;
		AddToPage[vlist]; vlist←NIL;
		-- if the page is not empty, flush out everything waiting to be output
		FlushOutput[maxdeadcycles: 25];
		IF (lev←CurLev[])>1 THEN
			BEGIN OPEN TexIODefs;
			Ps["\end occured on level "]; Wn[lev];
			END;
		RETURN; -- return to MainControl
		END;

	fntfam => DoFntFam[cc.mfont];

	hmove => Append[ScanMovedBox[cc.neg]];

	leaders => Store[ScanLeaders[]];

	halign => TexAlignDefs.HAlign[vhead,FALSE];

	vskip => Store[SkipGlue[cc.gluetype]];

	hrule => BEGIN Store[ScanRuleNode[]]; prevdepth←pflag END;

	box => Append[GetBox[cc.boxtype]];

	topbotins => BEGIN CheckPriv; DoTopBotIns[cc.topbot, vlist, Store] END;

	mark => BEGIN CheckPriv; Store[MakeMarkNode[ScanToks[mark]]] END;

	hangindent => SetGlobalHangIndent[ScanHang[]];

	penlty => Store[ScanPenltyNode[]];

	eject => Store[MakeEjectNode[]];

	ENDCASE => CommonCmd;

	END;
	IF NOT restricted THEN
		BEGIN AddToPage[vlist]; vlist←InitNodeList[] END;
	ENDLOOP;
	END;

IndentBox: PROCEDURE[indent: Dimn] RETURNS[BoxNodePtr] = --INLINE--
	BEGIN
	q: BoxNodePtr←NullBox[];
	q.width←indent; q.altered←TRUE; RETURN[q];
	END;

outputroutine: TexTokenDefs.TokenListPtr←NIL;

SetOutputRoutine: PUBLIC PROCEDURE[t: TexTokenDefs.TokenListPtr] =
	BEGIN
	IF outputroutine#NIL THEN TexTokenDefs.DelRCLink[outputroutine];
	outputroutine←t;
	END;

RunOutputRoutine: PUBLIC PROCEDURE RETURNS[BoxNodePtr] =
	BEGIN
	IF outputroutine=NIL THEN RETURN[Page[]]
	ELSE
		BEGIN
		vlist: NodeListPtr←InitNodeList[];
		vhead: VHead←[vlist,pflag];
		InsRCList[outputroutine];
		NewSaveLevel[outputend];
		VMode[@vhead, TRUE]; -- run the output routine in restricted VMode
		UnSave[outputend];
		IF vlist.link=NIL THEN BEGIN FreeNodeList[vlist]; RETURN[NIL] END
		ELSE RETURN[TexPackDefs.VBox[vlist]];
		END;
	END;

END.