-- TexFont.mesa
-- Mesa 6 version
-- Last changed by Doug Wyatt, September 23, 1980  3:58 PM

DIRECTORY
	TexDefs: FROM "TexDefs",
	TexErrorDefs: FROM "TexErrorDefs",
	TexFileDefs: FROM "TexFileDefs",
	TexFontDefs: FROM "TexFontDefs",
	TexGlueDefs: FROM "TexGlueDefs",
	TexIODefs: FROM "TexIODefs",
	TexMemDefs: FROM "TexMemDefs",
	TexStringDefs: FROM "TexStringDefs",
	TfmDefs: FROM "TfmDefs",
	AltoFileDefs: FROM "AltoFileDefs",
	DirectoryDefs: FROM "DirectoryDefs",
	ImageDefs: FROM "ImageDefs",
	SegmentDefs: FROM "SegmentDefs",
	StreamDefs: FROM "StreamDefs",
	StringDefs: FROM "StringDefs";

TexFont: PROGRAM
IMPORTS TexFileDefs,TexErrorDefs,TexGlueDefs,TexIODefs,
	TexMemDefs,TexStringDefs,
	DirectoryDefs,ImageDefs,StreamDefs,StringDefs
EXPORTS TexFontDefs =
BEGIN OPEN TexDefs,TfmDefs,TexFontDefs;

FontDescriptor: TYPE = RECORD
	[
	finfo: POINTER TO FInfoArray,
	wdbase: POINTER TO DimnArray,  -- widths
	htbase: POINTER TO DimnArray,  -- heights
	dpbase: POINTER TO DimnArray,  -- depths
	icbase: POINTER TO DimnArray,  -- italic corrections
	krnbase: POINTER TO DimnArray, -- kerns
	ligbase: POINTER TO LigTable,  -- ligature table
	extbase: POINTER TO ExtTable,  -- extension table
	parbase: POINTER TO DimnArray,  -- parameters
	glue: TexGlueDefs.GluePtr, -- font glue
	header: FontHeader, -- name, micasize, type, and face
	fh: SegmentDefs.FileHandle -- the file handle
	];

FontDescriptorPtr: TYPE = POINTER TO FontDescriptor;

FontsArray: TYPE = ARRAY Font OF FontDescriptorPtr;

fonts: POINTER TO FontsArray;

FontProblem: PUBLIC SIGNAL = CODE;

FontDefined: PUBLIC PROCEDURE[f: Font] RETURNS[BOOLEAN] =
	BEGIN RETURN[fonts[f]#NIL] END;

ReadFontInfo: PUBLIC PROCEDURE[name: STRING, f: Font] =
	BEGIN OPEN StreamDefs,TexFileDefs;
	fdp: FontDescriptorPtr_NIL;
	tfm: TfmHeader;
	fdsize: CARDINAL=SIZE[FontDescriptor];
	tfsize: CARDINAL;
	p: POINTER;
	fh: FileHandle;
	stream: StreamHandle_NIL;
	ReadWords: PROCEDURE[p: POINTER, nw: CARDINAL] =
		BEGIN
		IF ReadBlock[stream,p,nw]#nw THEN SIGNAL FontProblem;
		END;

	IF FontDefined[f] THEN SIGNAL FontProblem;
	fh_OpenFileFromFP[LookupTfmFile[name], read !LookupFailed =>
		BEGIN OPEN TexIODefs,TexErrorDefs;
		BeginError; Ws["Lookup failed on "L]; Ws[name];
		Error[EndError[]]; GOTO Fail;
		END];
	stream_CreateWordStream[file: fh, access: Read];
	ReadWords[@tfm,SIZE[TfmHeader]];
	BEGIN OPEN tfm; tfsize_SIZE[FInfoArray]+nw+nh+nd+ni+nk+nl+ne+np END;
	fdp_TexMemDefs.AllocMem[fdsize+tfsize];
	ReadWords[(p_fdp+fdsize),tfsize];
	stream.destroy[stream]; stream_NIL;
	fdp.finfo_p; p_p+SIZE[FInfoArray];
	fdp.wdbase_p; p_p+tfm.nw;
	fdp.htbase_p; p_p+tfm.nh;
	fdp.dpbase_p; p_p+tfm.nd;
	fdp.icbase_p; p_p+tfm.ni;
	fdp.krnbase_p; p_p+tfm.nk;
	fdp.ligbase_p; p_p+tfm.nl;
	fdp.extbase_p; p_p+tfm.ne;
	fdp.parbase_p; -- p_p+tfm.np;
	MakeFontGlue[fdp];
	fdp.header_tfm.header;
	fdp.fh_fh;
	fonts[f]_fdp;
	EXITS Fail => NULL; --ERROR Quit;--
	END;

MakeFontGlue: PROCEDURE[fdp: FontDescriptorPtr] =
	BEGIN OPEN TexGlueDefs;
	-- make a GlueSpec for the font's space glue
	fdp.glue_MakeGlue[];
	fdp.glue.refs_infRefs;
	fdp.glue.space_fdp.parbase[spacewd];
	fdp.glue.flex[str]_[regular, fdp.parbase[spacestr]];
	fdp.glue.flex[shr]_[regular, fdp.parbase[spaceshr]];
	END;

GetFont: PROCEDURE[f: Font] RETURNS[FontDescriptorPtr] = INLINE
	BEGIN RETURN[fonts[f]] END;

CharWd: PUBLIC PROCEDURE[fc: FChar] RETURNS[Dimn] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[fc.font];
	RETURN[fdp.wdbase[fdp.finfo[fc.char].wd]];
	END -- of CharWd --;

CharHt: PUBLIC PROCEDURE[fc: FChar] RETURNS[Dimn] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[fc.font];
	RETURN[fdp.htbase[fdp.finfo[fc.char].ht]];
	END -- of CharHt --;

CharDp: PUBLIC PROCEDURE[fc: FChar] RETURNS[Dimn] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[fc.font];
	RETURN[fdp.dpbase[fdp.finfo[fc.char].dp]];
	END -- of CharDp --;

CharIc: PUBLIC PROCEDURE[fc: FChar] RETURNS[Dimn] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[fc.font];
	RETURN[fdp.icbase[fdp.finfo[fc.char].ic]];
	END -- of CharIc --;

pindex: ARRAY FontParType OF FPIndex _
	[slant,xheight,quad,extraspace];

FontPar: PUBLIC PROCEDURE[f: Font, p: FontParType] RETURNS[Dimn] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[f];
	IF p=extraspace AND fdp.header.type=symbol THEN RETURN[0]
	ELSE RETURN[fdp.parbase[pindex[p]]];
	END -- of FontPar --;

sindex: ARRAY SyParType OF FPIndex _
	[mathspace,num1,num2,num3,denom1,denom2,sup1,sup2,sup3,sub1,sub2,
	supdrop,subdrop,delim1,delim2,axisheight];

SyPar: PUBLIC PROCEDURE[f: Font, s: SyParType] RETURNS[Dimn] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[f];
	SELECT fdp.header.type FROM
		symbol => RETURN[fdp.parbase[sindex[s]]];
		ENDCASE => SIGNAL FontProblem;
	RETURN[0];
	END -- of SyPar --;

eindex: ARRAY ExParType OF FPIndex _
	[defaultrulethickness,bigopspacing1,bigopspacing2,
	bigopspacing3,bigopspacing4,bigopspacing5];

ExPar: PUBLIC PROCEDURE[f: Font, e: ExParType] RETURNS[Dimn] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[f];
	SELECT fdp.header.type FROM
		mathex => RETURN[fdp.parbase[eindex[e]]];
		ENDCASE => SIGNAL FontProblem;
	RETURN[0];
	END -- of ExPar --;

FontGlue: PUBLIC PROCEDURE[f: Font] RETURNS[TexGlueDefs.GluePtr] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[f];
	RETURN[fdp.glue];
	END -- of FontGlue --;

FontHdr: PUBLIC PROCEDURE[f: Font] RETURNS[POINTER TO FontHeader] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[f];
	RETURN[@fdp.header];
	END -- of FontHdr --;

Ligature: PUBLIC PROCEDURE[fc: FChar, nextc: Char]
	RETURNS[type: LigType, info: LigInfo] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[fc.font];
	WITH lg:fdp.finfo[fc.char].lg SELECT FROM
		lig =>
			BEGIN
			i: CARDINAL_lg.i;
			entry: LigEntry;
				DO
				IF (entry_fdp.ligbase[i]).next=nextc THEN
					WITH e:entry SELECT FROM
						ligature => RETURN[lig,[lig[e.lig]]];
						kern => RETURN[krn,[krn[fdp.krnbase[e.k]]]];
						ENDCASE;
				IF entry.stop THEN EXIT ELSE i_i+1;
				ENDLOOP;
			END;
		ENDCASE;
	RETURN[none,[none[]]];
	END;

NextLarger: PUBLIC PROCEDURE[fc: FChar]
	RETURNS[type: LargerType, info: LargerInfo] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[fc.font];
	WITH lg:fdp.finfo[fc.char].lg SELECT FROM
		next => BEGIN type_nextlarger; info_[nextlarger[lg.c]] END;
		ext => BEGIN type_extensible; info_[extensible[[fc.font,lg.i]]] END;
		ENDCASE => BEGIN type_none; info_[none[]] END;
	RETURN[type,info];
	END;

xpart: ARRAY TfmDefs.ExtPart OF TexFontDefs.ExtPart =
	[top, mid, bot, ext];

ExtensionInfo: PUBLIC PROCEDURE[xinfo: ExtInfo] RETURNS[ExtArray] =
	BEGIN
	fdp: FontDescriptorPtr_GetFont[xinfo.font];
	xarray: ExtArray;
	xentry: ExtEntry_fdp.extbase[xinfo.index];
	p: TfmDefs.ExtPart;
	xc: TfmDefs.ExtChar;
	FOR p IN TfmDefs.ExtPart
		DO
		xc_xentry[p];
		xarray[xpart[p]]_[xc.present, [xinfo.font,xc.char]];
		ENDLOOP;
	RETURN[xarray];
	END;

FP: TYPE = AltoFileDefs.FP;

TfmDescriptor: TYPE = RECORD[link: TfmPtr, name: STRING, fp: FP];
TfmPtr: TYPE = POINTER TO TfmDescriptor;

tfmlist: TfmPtr_NIL;

AddTfmFile: PROCEDURE[name: STRING, fp: POINTER TO FP] =
	BEGIN
	tfm: TfmPtr;
	tfm_TexMemDefs.AllocMem[SIZE[TfmDescriptor]];
	tfm^_[link: tfmlist,
		name: TexStringDefs.CopyString[name], fp: fp^];
	tfmlist_tfm;
	END;

LookupTfmFile: PROCEDURE[name: STRING] RETURNS[fp: POINTER TO FP] =
	BEGIN
	tfm: TfmPtr;
	FOR tfm_tfmlist,tfm.link UNTIL tfm=NIL
		DO
		IF StringDefs.EquivalentString[name,tfm.name] THEN RETURN[@tfm.fp];
		ENDLOOP;
	SIGNAL TexFileDefs.LookupFailed[name];
	END;

FindTfmFiles: PROCEDURE =
	BEGIN
	name: STRING_[80];
	ext: STRING_[30];
	TestTfm: PROCEDURE[fp: POINTER TO FP, filename: STRING] RETURNS[BOOLEAN] =
		BEGIN
		name.length_ext.length_0;
		TexFileDefs.NameAndExtension[filename,name,ext];
		IF StringDefs.EquivalentString[ext,"tfm"L] THEN AddTfmFile[name,fp];
		RETURN[FALSE];
		END;
	DirectoryDefs.EnumerateDirectory[TestTfm];
	END;

FontCleanupItem: ImageDefs.CleanupItem _ [link: ,
	proc: FontCleanupProc, mask: ImageDefs.CleanupMask[Restore]];

FontCleanupProc: ImageDefs.CleanupProcedure =
	BEGIN
	IF why=Restore THEN FindTfmFiles;
	END;

FontInit: PROCEDURE =
	BEGIN
	f: Font;
	fonts_TexMemDefs.AllocMem[SIZE[FontsArray]];
	FOR f IN Font DO fonts[f]_NIL ENDLOOP;
	-- ImageDefs.AddCleanupProcedure[@FontCleanupItem];
	FontCleanupProc[Restore];
	END;

FontInit;

END.