-- TexMathA.mesa

-- Tex routines for dealing with math mode
-- last written by Doug Wyatt, December 5, 1979  2:19 AM

DIRECTORY
	TexDefs: FROM "TexDefs",
	TexErrorDefs: FROM "TexErrorDefs",
	TexFontDefs: FROM "TexFontDefs",
	TexGlueDefs: FROM "TexGlueDefs",
	TexIODefs: FROM "TexIODefs",
	TexMathDefs: FROM "TexMathDefs",
	TexMathOpDefs: FROM "TexMathOpDefs",
	TexNodeDefs: FROM "TexNodeDefs",
	TexPackDefs: FROM "TexPackDefs",
	TexTableDefs: FROM "TexTableDefs",
	InlineDefs: FROM "InlineDefs";

TexMathA: PROGRAM
IMPORTS TexErrorDefs,TexFontDefs,TexGlueDefs,TexIODefs,TexMathDefs,
	TexNodeDefs,TexPackDefs,TexTableDefs,InlineDefs
EXPORTS TexMathOpDefs =
BEGIN OPEN TexNodeDefs,TexDefs,TexMathDefs,TexMathOpDefs;

AssumptionViolated: SIGNAL = CODE;

fontSize: ARRAY StyleStyle OF MathSize _ [text,text,scr,scrscr];

-- the size associated with a given style
FontSize: PUBLIC PROCEDURE[s: MathStyle] RETURNS[MathSize] = --INLINE--
	BEGIN RETURN[fontSize[s.style]] END;

scrStyle: ARRAY StyleStyle OF StyleStyle _ [script,script,scriptscript,scriptscript];

-- the superscript style associated with a given style
ScrStyle: PUBLIC PROCEDURE[s: MathStyle] RETURNS[MathStyle] = --INLINE--
	BEGIN RETURN[[variant: s.variant, style: scrStyle[s.style]]] END;

-- the variant style associated with a given style
UndStyle: PUBLIC PROCEDURE[s: MathStyle] RETURNS[MathStyle] = --INLINE--
	BEGIN RETURN[[variant: atop, style: s.style]] END;

fracStyle: ARRAY StyleStyle OF StyleStyle _ [text,script,scriptscript,scriptscript];

-- numerator style associated with a given style
NumStyle: PUBLIC PROCEDURE[s: MathStyle] RETURNS[MathStyle] = --INLINE--
	BEGIN RETURN[[variant: s.variant, style: fracStyle[s.style]]] END;

-- denominator style associated with a given style
DenomStyle: PUBLIC PROCEDURE[s: MathStyle] RETURNS[MathStyle] = --INLINE--
	BEGIN RETURN[[variant: atop, style: fracStyle[s.style]]] END;

-- font code for given math font of given size
MathFontTable: PUBLIC PROCEDURE[s: MathSize, t: MFont]
	RETURNS[Font] = --INLINE--
	BEGIN
	RETURN[TexTableDefs.CurMathFont[MFTIndex[mfont: t, msize: s]]];
	END;

MathFontPar: PUBLIC PROCEDURE[par: TexFontDefs.FontParType, size: MathSize]
	RETURNS[Dimn] =
	BEGIN
	RETURN[TexFontDefs.FontPar[MathFontTable[size,sy],par]];
	END;

MathPar: PUBLIC PROCEDURE[par: TexFontDefs.SyParType, size: MathSize]
	RETURNS[Dimn] =
	BEGIN
	RETURN[TexFontDefs.SyPar[MathFontTable[size,sy],par]];
	END;

MathExPar: PUBLIC PROCEDURE[par: TexFontDefs.ExParType]
	RETURNS[Dimn] =
	BEGIN
	RETURN[TexFontDefs.ExPar[MathFontTable[text,ex],par]];
	END;

BoxChar: PUBLIC PROCEDURE[c: MChar, style: MathStyle, corr: BOOLEAN]
	RETURNS[box: BoxNodePtr, fount: Font] =
	BEGIN
	-- This procedure returns a pointer to a box containing the single
	-- math character c, using the style parameter to govern its choice of
	-- fonts. If corr is true, the box is made artificially wider by the
	-- italic correction for c. The return value fount is set to the number
	-- of the font actually used
	f: Font_MathFontTable[FontSize[style],c.mfont];
	ch: FChar_[f,c.char];
	b: BoxNodePtr_MakeCharBox[ch];
	IF corr AND c.mfont#ex THEN
		BEGIN
		ic: Dimn_TexFontDefs.CharIc[ch]; -- italic correction
		IF ic#0 THEN
			BEGIN
			b.width_b.width+ic; b.altered_TRUE; -- mark box nonstandard
			END;
		END;
	RETURN[box: b, fount: f];
	END;

MakeCharBox: PUBLIC PROCEDURE[c: FChar] RETURNS[BoxNodePtr] =
	BEGIN OPEN TexFontDefs;
	RETURN[MakeBoxNode[dir: hlist, head: MakeCharNode[c],
		h: CharHt[c], d: CharDp[c], w: CharWd[c]]];
	END;

-- The following procedure is in a sense the inverse of BoxChar.
-- If the box b contains a single character node, SingleCharBox returns
-- a pointer to that char Node, otherwise it returns NIL
SingleCharBox: PUBLIC PROCEDURE[b: BoxNodePtr]
	RETURNS[CharNodePtr] = --INLINE--
	BEGIN
	c: NodePtr;
	IF b#NIL AND (c_b.head)#NIL AND c.link=NIL THEN
		WITH cc:c SELECT FROM
			char => RETURN[@cc];
			ENDCASE;
	RETURN[NIL];
	END;

-- The boxchar procedure puts single characters into explicit boxes for
-- convenience in the mmode programs. Unfortunately this can consume a
-- lot of memory space, especially in a large table of numeric data,
-- when there are no italic corrections. Therefore the following
-- straightforward procedures are applied after a formula has been built

CompactBox: PUBLIC PROCEDURE[p: BoxNodePtr] RETURNS[NodePtr] =
	BEGIN
	-- The box pointed to by p is replaced by a single character box
	-- if possible, and so are all subboxes within p
	r: NodePtr_p.head;
	IF r=NIL THEN RETURN[p]; -- empty box
	IF r.link#NIL THEN
		BEGIN -- list longer than one node
		list: NodeListPtr_InitNodeList[];
		list.link_r; CompactList[list];
		p.head_FinishNodeList[list]; RETURN[p];
		END;
	WITH rr:r SELECT FROM
		box => p.head_r_CompactBox[@rr];
		ENDCASE;
	-- Unbox a single non-altered unshifted character
	IF r.type=char AND p.shiftamt=0 AND NOT p.altered THEN
		BEGIN p.head_NIL; DsNode[p]; RETURN[r] END
	ELSE RETURN[p];
	END;

CompactList: PUBLIC PROCEDURE[list: NodeListPtr] =
	BEGIN
	-- All boxes in the given list are CompactBoxed
	-- list.last need not be correct when CompactList is called
	-- upon exit, list.link and list.last are both updated
	q,r,s,nextq: NodePtr; -- pointers which run through the list (q=r.link)
	r_list; q_r.link;
	WHILE q#NIL
		DO
		nextq_q.link;
		WITH qq:q SELECT FROM
			box => IF (s_CompactBox[@qq])#q THEN
				BEGIN r.link_q_s; q.link_nextq END;
			ENDCASE;
		r_q; q_nextq;
		ENDLOOP;
	list.last_r;
	END;

MathGlue: PUBLIC PROCEDURE[spec: MathGlueSpec, quad: Dimn]
	RETURNS[GlueNodePtr] =
	BEGIN OPEN InlineDefs, TexGlueDefs;
	-- returns a pointer to a glue node specifying (x/d)*quad,
	-- (y/d)*quad, (z/d)*quad as its glue parameters
	q: CARDINAL_ABS[quad];
	sp,strval,shrval: Dimn;
	p: GluePtr_MakeGlue[];
	sp_LongDiv[LongMult[spec.x,q],spec.d];
	strval_LongDiv[LongMult[spec.y,q],spec.d];
	shrval_LongDiv[LongMult[spec.z,q],spec.d];
	IF quad<0 THEN BEGIN sp_-sp; strval_-strval; shrval_-shrval END;
	p.space_sp; p.flex[str]_[regular,strval]; p.flex[shr]_[regular,shrval];
	RETURN[MakeGlueNode[p]];
	END;

MakeMathGlue: PUBLIC PROCEDURE[sp: MathSpace, size: MathSize]
	RETURNS[GlueNodePtr] =
	BEGIN
	g: GlueNodePtr_NIL;
	quad: Dimn_MathFontPar[quad,size];
	SELECT sp FROM
		thin => g_MathGlue[thinGlue,quad];
		th => IF size=text THEN g_MathGlue[thinGlue,quad];
		thick => IF size=text THEN g_MathGlue[thickGlue,quad];
		quad => g_MathGlue[quadGlue,quad];
		user => IF size=text THEN g_MathGlue[opGlue,quad]
			ELSE g_MathGlue[thinGlue,quad];
		negthin => g_MathGlue[thinGlue,-quad];
		negth => IF size=text THEN g_MathGlue[thinGlue,-quad];
		negthick => IF size=text THEN g_MathGlue[thickGlue,-quad];
		negop => IF size=text THEN g_MathGlue[opGlue,-quad];
		ENDCASE => SIGNAL TexErrorDefs.Confusion; -- invalid MathSpace
	RETURN[g];
	END;

VarSymbol: PUBLIC PROCEDURE[delim: Delimiter, style: MathStyle, size: Dimn]
	RETURNS[BoxNodePtr] =
	BEGIN OPEN TexFontDefs;
	-- This procedure returns a pointer to a box containing a symbol of
	-- varying size, the smallest available symbol whose height+depth is
	-- greater than or equal to the given size. The symbol must also be at
	-- least as large as the symbols of the current style. If necessary, a
	-- large symbol will be constructed from individual pieces. The parameter
	-- delim is a delimiter specification. If delim=nullDelimiter, the box
	-- will be empty and its width will be 2/3 of a thin space.
	p: FChar;
	pdefined: BOOLEAN_FALSE;
	c1,c2: MChar;
	b: BoxNodePtr;

	BEGIN
	IF delim.small.exists THEN
		BEGIN -- try to find small variant that is large enough
		j: MathSize;
		c1_delim.small.mchar;
		pdefined_TRUE;
		-- note that "DECREASING" MathSize means increasing the size!
		FOR j DECREASING IN[FIRST[MathSize]..FontSize[style]]
			DO
			p_[font: MathFontTable[j, c1.mfont], char: c1.char];
			IF (CharHt[p]+CharDp[p])>=size THEN GOTO CharFound;
			ENDLOOP;
		END;
	-- now look for larger symbol in mathex font
	IF NOT delim.large.exists THEN
		GOTO CharFound; -- p is best we can do although it wasn't big enough
	c2_delim.large.mchar;
	IF c2.mfont#ex THEN
		BEGIN OPEN TexIODefs, TexErrorDefs;
		BeginError; Ws["Large delimiter "]; WMCharOctal[c2];
		Ws[" should be in mathex font"];
		Error[EndError[]];
		GOTO CharFound; -- use p if pdefined
		END;
	p_[font: MathFontTable[text,ex], char: c2.char]; pdefined_TRUE;
		DO
		BEGIN
		c: Char;
		ltype: LargerType; linfo: LargerInfo;
		[ltype,linfo]_NextLarger[p];
		WITH info:linfo SELECT ltype FROM
			none => GOTO CharFound; -- there is no larger size
			nextlarger => c_info.next; -- c is next larger char
			extensible =>
				BEGIN -- We will construct a variable-size symbol
				b_ExtendSymbol[info.index, style, size];
				EXIT;
				END;
			ENDCASE;
		IF (CharHt[p]+CharDp[p])>=size THEN GOTO CharFound;
		p.char_c; -- advance to next larger size
		END;
		ENDLOOP;
	EXITS
	CharFound => IF pdefined THEN b_MakeCharBox[p] -- box character p
		ELSE
			BEGIN -- no character found, so fabricate an empty box
			b_NullBox[];
			b.width_MathFontPar[quad,FontSize[style]]/9; b.altered_TRUE;
			END;
	END;
	RETURN[b];
	END;

ExtendSymbol: PROCEDURE[info: TexFontDefs.ExtInfo,
	style: MathStyle, size: Dimn]
	RETURNS[BoxNodePtr] =
	BEGIN OPEN TexFontDefs;
	axis,s,exth: Dimn;
	x: ExtPart;
	echars: ExtArray;
	f: Font;
	n: CARDINAL;
	list: NodeListPtr_InitNodeList[];
	Present: PROCEDURE[x: ExtPart] RETURNS[BOOLEAN] = --INLINE--
		BEGIN RETURN[echars[x].present] END;
	EChar: PROCEDURE[x: ExtPart] RETURNS[FChar] = --INLINE--
		BEGIN RETURN[echars[x].char] END;
	StorePart: PROCEDURE[x: ExtPart] = --INLINE--
		BEGIN StoreNode[list, MakeCharNode[echars[x].char]] END;

	axis_MathPar[axisheight,FontSize[style]];
	echars_ExtensionInfo[info]; f_info.font;
	IF NOT Present[ext] THEN
		ERROR TexErrorDefs.Confusion; -- ext part should always be present
	-- increase s to the appropriate final size
	s_0; FOR x IN [top..bot] DO IF Present[x] THEN s_s+CharDp[EChar[x]] ENDLOOP;
	exth_CharDp[EChar[ext]]; -- exth is the allowable height increment
	-- if there is a middle, must add extensions in pairs
	IF Present[mid] THEN exth_2*exth;
	n_0; WHILE s<size DO n_n+1; s_s+exth ENDLOOP;
	-- now fabricate the symbol as a vlist
	IF Present[top] THEN StorePart[top];
	THROUGH [1..n] DO StorePart[ext] ENDLOOP;
	IF Present[mid] THEN
		BEGIN
		StorePart[mid];
		THROUGH [1..n] DO StorePart[ext] ENDLOOP;
		END;
	IF Present[bot] THEN StorePart[bot];
	RETURN[MakeBoxNode[dir: vlist, head: FinishNodeList[list],
		h: s/2+axis, d: s/2-axis, w: CharWd[EChar[ext]]]];
	END;


FractionRule: PUBLIC PROCEDURE[desiredthickness: Dimn] RETURNS[NodePtr] =
	BEGIN -- yields a rulenode of the given thickness
	-- width extends to boundary of containing vlist, depth is zero
	RETURN[MakeRuleNode[width: nilDimn, height: desiredthickness, depth: 0]];
	END;

OverBar: PUBLIC PROCEDURE[p: NodePtr, desiredheight, desiredthickness, clr: Dimn]
	RETURNS[BoxNodePtr] =
	BEGIN
	-- yields a box consisting of box p with a vinculum placed overhead,
	-- and a blank space (equal to clr) above that. The parameter
	-- "desiredheight" indicates the top of the vinculum, not the top
	-- of the whole box
	list: NodeListPtr_InitNodeList[];
	StoreNode[list, MakeSpace[clr]];
	StoreNode[list, FractionRule[desiredthickness]];
	StoreNode[list, MakeGlueNode[TexGlueDefs.CommonGlue[fill]]];
	StoreNode[list, p];
	RETURN[TexPackDefs.VPack[list, desiredheight+clr]];
	END;

ReBox: PUBLIC PROCEDURE[p: BoxNodePtr, desiredwidth, offset: Dimn]
	RETURNS[BoxNodePtr] =
	BEGIN OPEN TexGlueDefs;
	-- changes box p into a box of width desiredwidth+offset,
	-- centering it with lowerfillglue at each end but shifted right
	-- by the given offset. (The reason for using lowerfillglue is so that
	-- (a) fillglue will still be effective if centering was not really
	-- desired by the user, and (b) lowerfillglue will also shrink so that
	-- the box can be made narrower than its natural width.)
	-- It is assumed that p.shiftamt=0
	q1,q2,q3: NodePtr;
	delta: Dimn_desiredwidth-p.width;
	dir: FlexDir_IF delta<0 THEN shr ELSE str;
	lfg: GluePtr_CommonGlue[lowerfill];
	sumsarray: FlexSums; sums: FlexSumsPtr_@sumsarray;

	IF p.shiftamt#0 THEN SIGNAL AssumptionViolated;

	q1_MakeGlueNode[lfg]; q2_MakeGlueNode[lfg];
	q3_MakeSpace[offset];
	q1.link_q3;

	ClearFlexSums[sums];
	SumFlex[lfg, sums]; SumFlex[lfg, sums]; -- flex from two lfg nodes

	IF p.dir=hlist AND p.glueset=zeroGlueSet AND NOT p.altered THEN
		BEGIN -- a nice box, unwrap it and add the new glue
		b: NodePtr;
		t: NodePtr_q3; -- will eventually point to last node in p's list
		q3.link_p.head; p.head_q1;
		WHILE (b_t.link)#NIL
			DO -- recompute total stretch and shrink
			WITH bb:b SELECT FROM glue => SumFlex[bb.g, sums]; ENDCASE;
			t_b;
			ENDLOOP;
		t.link_q2; -- attach the righthand lowerfillglue node
		p.glueset_SetGlue[dir, ABS[delta], sums]; p.altered_TRUE;
		p.width_desiredwidth+offset;
		RETURN[p];
		END
	ELSE -- put box p (which wasn't so nice) into a larger box
		BEGIN
		b: BoxNodePtr_MakeBoxNode[dir: hlist, head: q1,
			w: desiredwidth+offset, h: p.height, d: p.depth];
		b.glueset_SetGlue[dir, ABS[delta], sums]; b.altered_TRUE;
		q3.link_p; p.link_q2;
		RETURN[b];
		END;
	END;

CleanBox: PUBLIC PROCEDURE[p: BoxNodePtr] RETURNS[BoxNodePtr] =
	BEGIN
	-- makes sure that p points to a box with shiftamt=0,
	-- given that p is either NIL or a pointer to a box
	IF p=NIL THEN RETURN[NullBox[]];
	IF p.link#NIL THEN SIGNAL AssumptionViolated;
	IF p.shiftamt=0 THEN RETURN[p]
	ELSE
		BEGIN
		list: NodeListPtr_InitNodeList[];
		StoreNode[list,p];
		RETURN[TexPackDefs.HBox[list]];
		END;
	END;

END.