-- TexHMode.mesa

-- last written by Doug Wyatt, January 9, 1980  10:07 PM

DIRECTORY
	TexAlignDefs: FROM "TexAlignDefs",
	TexDefs: FROM "TexDefs",
	TexErrorDefs: FROM "TexErrorDefs",
	TexFontDefs: FROM "TexFontDefs",
	TexGlueDefs: FROM "TexGlueDefs",
	TexMainDefs: FROM "TexMainDefs",
	TexNodeDefs: FROM "TexNodeDefs",
	TexPackDefs: FROM "TexPackDefs",
	TexSynDefs: FROM "TexSynDefs",
	TexTableDefs: FROM "TexTableDefs",
	InlineDefs: FROM "InlineDefs";

TexHMode: PROGRAM
IMPORTS TexAlignDefs,TexErrorDefs,TexFontDefs,TexGlueDefs,TexMainDefs,
	TexNodeDefs,TexPackDefs,TexSynDefs,TexTableDefs,InlineDefs
EXPORTS TexMainDefs =
BEGIN OPEN TexMainDefs,TexTableDefs,TexNodeDefs,TexSynDefs,TexDefs;

-- *******************
-- * Horizontal mode *
-- *******************

HAppend: PUBLIC PROCEDURE[hh: HHeadPtr, b: BoxNodePtr] =
	BEGIN OPEN hh;
	-- append a box node to the current hlist
	StoreNode[hlist, b]; spacefactor←sfOne;
	END;


HMode: PUBLIC PROCEDURE[hhead: HHeadPtr, restricted: BOOLEAN] =
	BEGIN OPEN hhead;
	CheckPriv: PROCEDURE = BEGIN IF restricted THEN SIGNAL FallThru END;
	Store: PROCEDURE[p: NodePtr] =
		BEGIN StoreNode[hlist, p] END;
	Append: PROCEDURE[b: BoxNodePtr] = INLINE
		BEGIN HAppend[hhead,b]; END; 

	GetNext[];
	DO
	BEGIN
	ENABLE
		BEGIN
		FallThru => BEGIN SIGNAL CantDoThat[h, 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
		topinsend,botinsend => EXIT; -- end of insertion
		justend => EXIT; -- end of justification (e.g., \hbox par ...)
		aligncode,outputend,mathcode,mathleft,mathblock,endscanmath,endvcenter =>
			ERROR TexErrorDefs.Confusion; -- invalid endcode in HMode
		ENDCASE => ERROR; -- bad EndingCode

	mathbr =>
		BEGIN
		GetNCTok;
		IF curcmd=mathbr THEN -- display math mode
			BEGIN IF restricted THEN SIGNAL FallThru ELSE EXIT END
		ELSE BEGIN BackInput; AppendFormula[hlist] END;
		END;

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

	spacer,exspace =>
		BEGIN
		curfont: Font←CurFont[];
		p: TexGlueDefs.GluePtr←TexFontDefs.FontGlue[curfont];
		IF spacefactor#sfOne AND curcmd#exspace THEN
			p←ApplySpaceFactor[p, spacefactor];
		Store[MakeGlueNode[p]];
		END;

	mathspace => SELECT cc.space FROM
		negthin =>
			BEGIN
			-- hack: this is the routine for \!
			GetNCTok; IF curcmd#spacer THEN LOOP;
			END;
		quad =>
			BEGIN
			-- \quad in horizontal mode
			curfont: Font←CurFont[];
			Store[MakeSpace[TexFontDefs.FontPar[curfont,quad]]];
			END;
		ENDCASE => SIGNAL FallThru;

	letter,otherchar,nonmathletter =>
		BEGIN OPEN TexFontDefs;
		curfont: Font←CurFont[];
		c: Char←cc.char;
		lchar: Char←c;
		t: FChar;
		hyph: Char='-; -- HyphenChar[curfont]???
		sf: SpaceFactor;
		ligtype: LigType; liginfo: LigInfo;
		kern: Dimn←0;
			DO
			sf←SfTable[c];
			IF sf#0 AND NOT UpperCaseLetter[hlist.last] THEN spacefactor←sf; 
			-- no spacefactor correction is made after
			-- upper case letters (consider, e.g., "D. E. Knuth")
			t←[curfont,c];
			GetNext[];
			SELECT curcmd FROM
				letter,otherchar => c←cc.char;
				ENDCASE => EXIT;
			[ligtype,liginfo]←Ligature[t, c];
			WITH ll:liginfo SELECT ligtype FROM
				lig => BEGIN lchar←c; c←ll.char END;
				krn => BEGIN kern←ll.kern; EXIT END;
				none => EXIT;
				ENDCASE => ERROR; -- bad LigType
			ENDLOOP;
		Store[MakeCharNode[t]];
		IF lchar=hyph THEN Store[MakePenaltyNode[0]];
		IF kern#0 THEN Store[MakeKernNode[kern]];
		LOOP; -- reswitch
		END;

	parend => IF NOT restricted THEN EXIT;

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

	font => SetFont[ScanFont[]];

	ascii => InsToken[[otherchar[ScanAscii[]]]];

	fntfam => DoFntFam[cc.mfont];

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

	leaders => Store[ScanLeaders[]];

	valign => TexAlignDefs.VAlign[hhead];

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

	vrule => BEGIN Store[ScanRuleNode[]]; spacefactor←sfOne END;

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

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

	discr => Store[MakeDiscNode[[CurFont[], cc.char]]];

	accent => Store[DoAccent[cc.char]];

	caseshift => SIGNAL Unimplemented;

	italcorr =>
		BEGIN
		WITH qq:hlist.last SELECT FROM
			char =>
				BEGIN
				corr: Dimn←TexFontDefs.CharIc[qq.c]; -- italic correction
				IF corr#0 THEN
					BEGIN
					b: BoxNodePtr←NullBox[];
					b.width←corr; b.altered←TRUE; Store[b];
					END;
				END;
			ENDCASE => TexErrorDefs.Error["Italic correction must follow an explicit character"];
		spacefactor←sfOne;
		END;

	hangindent =>
		BEGIN
		hang: HangSpec←ScanHang[];
		IF restricted THEN SetHangIndent[hang] ELSE SetGlobalHangIndent[hang];
		END;

	unskip => IF hlist.last.type=glue THEN DeleteLastNode[hlist];

	penlty => Store[ScanPenltyNode[]];

	eject => Store[MakeEjectNode[]];

	ENDCASE => CommonCmd;
	END;
	GetNext[];
	ENDLOOP;
	RETURN;
	END;

ApplySpaceFactor: PROCEDURE[p: TexGlueDefs.GluePtr, sf: SpaceFactor]
	RETURNS[TexGlueDefs.GluePtr] =
	BEGIN OPEN TexGlueDefs;
	AlterFlexVal: PROCEDURE[f: POINTER TO Flex, num,den: Dimn] = --INLINE--
		BEGIN OPEN InlineDefs;
		f.val←LongDiv[LongMult[f.val,num]+den/2,den];
		END;
	q: GluePtr←MakeGlue[];
	q.space←p.space;
	q.flex←p.flex;
	AlterFlexVal[@q.flex[str],sf,1000]; -- stretch←stretch*spacefactor
	AlterFlexVal[@q.flex[shr],1000,sf]; -- shrink←shrink/spacefactor
	RETURN[q];
	END;

UpperCaseLetter: PROCEDURE[p: NodePtr] RETURNS[BOOLEAN] =
	BEGIN
	WITH pp:p SELECT FROM
		char => IF pp.c.char IN['A..'Z] THEN RETURN[TRUE];
		ENDCASE;
	RETURN[FALSE];
	END;

DeleteLastNode: PROCEDURE[list: NodeListPtr] =
	BEGIN
	p,q,r: NodePtr;
	IF list.link=NIL THEN RETURN;
	r←list.last; p←list;
	WHILE (q←p.link)#r DO p←q ENDLOOP;
	(list.last←p).link←NIL;
	DsNode[r];
	END;

DoAccent: PROCEDURE[achar: Char] RETURNS[BoxNodePtr] =
	BEGIN OPEN TexFontDefs;
	curfont: Font←CurFont[];
	f: Font←curfont; -- font for accent
	a: FChar←[f, achar]; -- the accent
	s: Dimn←FontPar[f,slant]; -- slant of accent's font
	t: Dimn←FontPar[f,xheight]; -- xheight of accent's font
	-- a, the accent, has slant s and is designed for characters of height t
	q: BoxNodePtr; -- a box for the accent
	h,w: Dimn; -- height and width of accentee
	c: Char; -- the accentee's char
	fc: FChar; -- the accentee, with font
	b: BoxNodePtr; -- the box enclosing the above vlist
		DO
		GetNCTok[]; IF curcmd#font THEN EXIT;
		SetFont[curfont←ScanFont[]];
		ENDLOOP;
	WITH cc:curchar SELECT curcmd FROM
		ascii => c←ScanAscii[];
		letter,otherchar,nonmathletter => c←cc.char;
		ENDCASE =>
			BEGIN
			TexErrorDefs.Error["Only single characters can be accented in horizontal mode"];
			ERROR Reswitch;
			END;
	fc←[curfont,c]; -- the accentee as an FChar
	h←CharHt[fc]; w←CharWd[fc]; -- height, width of accentee
	q←MakeBoxNode[dir: hlist, head: MakeCharNode[a],
		h: CharHt[a], w: CharWd[a], d: CharDp[a]]; -- box for accent
	q.shiftamt←(w-q.width)/2 -- 'center' accent over accentee
		+SlantShift[h, FontPar[curfont,slant]] -- adjust for accentee's slant
		-SlantShift[t, s]; -- adjust for accent's slant
	-- make a vlist: accent, glue, accentee
		BEGIN list: NodeListPtr←InitNodeList[];
		StoreNode[list,q];
		StoreNode[list,MakeGlueNode[TexGlueDefs.CommonGlue[lowerfill]]];
			-- lowerfillglue is used here since it will have to shrink
		StoreNode[list,MakeCharNode[fc]];
		b←TexPackDefs.VPack[list, q.height+h-t];
		END;
	b.width←w;
	RETURN[b];
	END;

SlantShift: PROCEDURE[h: Dimn, slant: Dimn] RETURNS[Dimn] =
	BEGIN
	i: LONG INTEGER←h;
	i←((i*slant)+500)/1000;
	RETURN[InlineDefs.LowHalf[i]];
	END;

AppendFormula: PROCEDURE[hlist: NodeListPtr] =
	BEGIN
	flist: NodeListPtr←InitNodeList[];
	surr: TexDefs.Dimn;
	GetFormula[flist]; -- scan a formula in restricted MMode
	-- now tlist is the hlist for a math formula in text. We will surround
	-- it with hyphenation control nodes and append it to the current hlist.
	surr←TexTableDefs.DimnParam[mathsurround];
	StoreNode[hlist,MakeHyphNode[off]];
	IF surr#0 THEN StoreNode[hlist,MakeKernNode[surr]];
	AppendNodeList[hlist,flist];
	IF surr#0 THEN StoreNode[hlist,MakeKernNode[surr]];
	StoreNode[hlist,MakeHyphNode[on]];
	END;

END.