-- FontWidth.mesa
-- Written by Joe Maleson
-- Last changed by Doug Wyatt, October 22, 1980  3:46 PM

DIRECTORY
	InlineDefs,
	MiscDefs,
	PressDefs USING[MulDiv,SignedMulDiv,missingWidth],
	StreamDefs,
	StringDefs,
	SystemDefs;

FontWidth: PROGRAM
IMPORTS PressDefs, InlineDefs, MiscDefs, StreamDefs, StringDefs, SystemDefs
EXPORTS PressDefs =
BEGIN OPEN PressDefs;

Byte: TYPE = [0..377B];

IndexHeader: TYPE = MACHINE DEPENDENT RECORD
 [ Type: [0..15],
	Length: [0..4095]
 ];

IndexType: TYPE = MACHINE DEPENDENT {end,name,splines,chars,widths};

RawIndex: TYPE = MACHINE DEPENDENT RECORD
 [	hdr: IndexHeader,
	variantPart: SELECT COMPUTED IndexType FROM
		end	=> NULL,
		name	=>
			[
			Code: CARDINAL,
			textLen: Byte,firstChar: CHARACTER,
			textBody: PACKED ARRAY [0..17) OF CHARACTER
			],
		splines,widths =>
			[
			fam: Byte,
			face: Byte,
			bc: Byte	,		-- First char number
			ec: Byte	,		-- and last
			siz: CARDINAL,		-- Font size (10 micron units)
			rotation: CARDINAL,		-- Rotation (anti clockwise)
			sa: ARRAY[0..2) OF CARDINAL,		--Starting address of data part
			len: ARRAY[0..2) OF CARDINAL		--Length of data part
			],
		chars =>
			[
			fam: Byte,
			face: Byte,
			bc: Byte	,		-- First char number
			ec: Byte	,		-- and last
			siz: CARDINAL,		-- Font size (10 micron units)
			rotation: CARDINAL,		-- Rotation (anti clockwise)
			sa: ARRAY[0..2) OF CARDINAL,		--Starting address of data part
			len: ARRAY[0..2) OF CARDINAL	,	--Length of data part
			resolutionx: CARDINAL,	-- 10*(number of bits/inch)
			resolutiony: CARDINAL	--       ditto
			],
		ENDCASE
 ];


Index: TYPE = RECORD
 [body: SELECT type: IndexType FROM
	end => NULL,
	name => 
		[
		Code: CARDINAL,
		Name: STRING
		],
	splines,widths =>
		[fam,face,bc,ec: Byte,
		siz,rotation: CARDINAL,
		sa: StreamDefs.StreamIndex,
		len: LONG CARDINAL
		],
	chars =>
		[fam,face,bc,ec: Byte,
		siz,rotation: CARDINAL,
		sa: StreamDefs.StreamIndex,
		len: LONG CARDINAL,
		resolutionx,resolutiony: CARDINAL
		],
	ENDCASE
 ];

--RawIndexHeader types
	IndexTypeEnd: CARDINAL = 0;
	IndexTypeName: CARDINAL = 1;
	IndexTypeSplines: CARDINAL = 2;
	IndexTypeChars: CARDINAL = 3;
	IndexTypeWidths: CARDINAL = 4;

--IndexHeader lengths
	IndexLEnd: CARDINAL = 1;
	IndexLName: CARDINAL = 11;
	IndexLSplines: CARDINAL = 9;
	IndexLChars: CARDINAL = 11;
	IndexLWidths: CARDINAL = 9;
	IndexLMax: CARDINAL = 11;

-- W I D T H   segment definitions

WTB: TYPE = MACHINE DEPENDENT RECORD
 [		--Width Table Block
	XL: CARDINAL,			--X offset
	YB: CARDINAL,			--Y offset
	XW: CARDINAL,			-- width
	YH: CARDINAL,			-- height
	XWidthFixed: BOOLEAN,
	YWidthFixed: BOOLEAN,
	spare14:	[0..37777B]
 ];


i: CARDINAL;	--global loop iteration variable

Upper: PROCEDURE [c: CHARACTER] RETURNS[CHARACTER]=
BEGIN
UC: ARRAY CHARACTER ['a..'z] OF CHARACTER = ['A,'B,'C,'D,'E,'F,'G,'H,'I,'J,'K,'L,'M,'N,'O,'P,'Q,'R,'S,'T,'U,'V,'W,'X,'Y,'Z];

IF c IN ['a..'z] THEN RETURN[UC[c]] ELSE RETURN[c];
END;

UpperCase: PROCEDURE [s: STRING] =
BEGIN
FOR i IN [0..s.length) DO s[i]_Upper[s[i]];
	ENDLOOP;
END;

fwReadIndex: PROCEDURE[s: StreamDefs.StreamHandle]
	RETURNS[POINTER TO Index] =
	BEGIN
	len: CARDINAL;
	t: RawIndex;
	resultHandle: POINTER TO Index _ SystemDefs.AllocateHeapNode[SIZE[Index]];
	str: STRING;
	long: LONG CARDINAL;
	strmIndex: StreamDefs.StreamIndex;
	IndexTypeSelector: ARRAY [0..5) OF IndexType = [end,name,splines,chars,widths];

	t.hdr_s.get[s];	--Type word
	len_t.hdr.Length;
	IF len > 0 THEN []_StreamDefs.ReadBlock[s,@t.variantPart,len-1];
		WITH dt: t SELECT IndexTypeSelector[t.hdr.Type] FROM
			end => 
				BEGIN
				resultHandle^ _ [end[]];
				END;
			name =>
				BEGIN
				str_SystemDefs.AllocateHeapString[dt.textLen];
IF dt.textLen > 20 THEN ERROR; --overflows SIZE[RawIndex];
				StringDefs.BcplToMesaString[LOOPHOLE[@dt.textBody-1, POINTER TO StringDefs.BcplSTRING],str];
				UpperCase[str];
				resultHandle^ _ [name[dt.Code,str]];
				END;
			chars =>
				BEGIN
				[strmIndex.page,strmIndex.byte] _ 
						InlineDefs.LDIVMOD[dt.sa[1],dt.sa[0],256];
				strmIndex.byte _ strmIndex.byte*2;
				long _ dt.len[1];long _ long*200000B+dt.len[0];
				resultHandle^ _ [chars[dt.fam,dt.face,dt.bc,dt.ec,
					dt.siz,dt.rotation,strmIndex,long,
					dt.resolutionx,dt.resolutiony]];
				END;
			splines =>
				BEGIN
				[strmIndex.page,strmIndex.byte] _ 
						InlineDefs.LDIVMOD[dt.sa[1],dt.sa[0],256];
				strmIndex.byte _ strmIndex.byte*2;
				long _ dt.len[1];long _ long*200000B+dt.len[0];
				resultHandle^ _ [splines[dt.fam,dt.face,dt.bc,dt.ec,
					dt.siz,dt.rotation,strmIndex,long]];
				END;
			widths =>
				BEGIN
				[strmIndex.page,strmIndex.byte] _ 
						InlineDefs.LDIVMOD[dt.sa[1],dt.sa[0],256];
				strmIndex.byte _ strmIndex.byte*2;
				long _ dt.len[1];long _ long*200000B+dt.len[0];
				resultHandle^ _ [widths[dt.fam,dt.face,dt.bc,dt.ec,
					dt.siz,dt.rotation,strmIndex,long]];
				END;
			ENDCASE;
	RETURN[resultHandle];
END;

LookupFontName: PUBLIC PROCEDURE [s:  StreamDefs.StreamHandle,famstr: STRING,face,siz,rot: INTEGER,bufx,bufy: POINTER TO ARRAY [0..256) OF INTEGER,boundbox: POINTER TO ARRAY [0..4) OF INTEGER]  RETURNS[BOOLEAN] = 
BEGIN 
	p: POINTER TO Index;
	found,end: BOOLEAN _ FALSE;
	fam: CARDINAL;
	best: widths Index;

	UpperCase[famstr];
	--siz is either micas (<0) or points (>0)
	IF siz < 0 THEN siz _ -siz ELSE siz _ MulDiv[siz,2540,72];
	s.reset[s];
		DO
			p_fwReadIndex[s];		--Read an Index entry
			WITH dp: p SELECT FROM
				end	=> BEGIN SystemDefs.FreeHeapNode[p];RETURN[FALSE];END;
				name	=>
					IF StringDefs.EqualString[dp.Name,famstr] THEN 
						BEGIN
						fam_dp.Code;
						SystemDefs.FreeHeapString[dp.Name];
						SystemDefs.FreeHeapNode[p];
						EXIT;
						END
					ELSE SystemDefs.FreeHeapString[dp.Name];
			ENDCASE;
		SystemDefs.FreeHeapNode[p];
		ENDLOOP;

	found _ FALSE;
	end _ FALSE;
		DO
		p_fwReadIndex[s];
	   WITH dp: p SELECT FROM
			end	=> EXIT;
			name =>	SystemDefs.FreeHeapString[dp.Name];
			widths	=>
				BEGIN
				IF dp.fam = fam AND dp.face = face AND
				((dp.siz = CARDINAL[siz] AND dp.rotation = CARDINAL[rot]) OR (dp.siz = 0)) THEN 
					BEGIN
					IF (found = FALSE) OR (dp.siz # 0) THEN
						best_dp;
					found_TRUE;
					END;
				END;
			ENDCASE;
		SystemDefs.FreeHeapNode[p];
		ENDLOOP;
	SystemDefs.FreeHeapNode[p];
	IF NOT found THEN RETURN[FALSE];
	CalculateWidths[@best,s,siz,rot,boundbox,bufx,bufy];
	RETURN[TRUE];
END;

CalculateWidths: PUBLIC PROCEDURE [best: POINTER TO widths Index,s: StreamDefs.StreamHandle,siz,rot: CARDINAL,boundbox: POINTER TO ARRAY[0..4) OF INTEGER,bufx,bufy: POINTER TO ARRAY[0..256) OF INTEGER] =
BEGIN
	wt: WTB;
	bc,ec,ecb: [0..256);
	xl,sl,tl: CARDINAL;	--really local values to a block further on
	cs,cm,ss,sm: INTEGER; --sign, mag for cos, sin
	bufl: CARDINAL = 256;
	spareBuff: ARRAY [0..256) OF INTEGER;
	
	IF bufx = NIL THEN bufx _ @spareBuff;
	MiscDefs.SetBlock[bufx,-1,bufl];
	IF bufy # NIL THEN MiscDefs.SetBlock[bufy,-1,bufl];
--Position s to read width table
	StreamDefs.SetIndex[s,best.sa];	--DP address of font part.
	[]_StreamDefs.ReadBlock[s,@wt,SIZE[WTB]];

--Extract the bounding box info
	IF boundbox # NIL THEN InlineDefs.COPY[to: boundbox,from: @wt,nwords: 4];		
	bc _ best.bc;
	ec _ best.ec;
	--if bufl ls bc then return		 - yes but...
	--let ecb=(ec ge bufl)? bufl,ec
		ecb_ec;

--Now read either one word or a number of words for the widths.
		IF wt.XWidthFixed THEN
				MiscDefs.SetBlock[bufx+bc,s.get[s],ecb-bc+1]
		ELSE []_StreamDefs.ReadBlock[s,bufx+bc,ecb-bc+1];

		IF bufy # NIL THEN
		IF wt.YWidthFixed THEN
			MiscDefs.SetBlock[bufy+bc,s.get[s],ecb-bc+1]
		ELSE []_StreamDefs.ReadBlock[s,bufy+bc,ecb-bc+1];

--Now do scaling if needed.
	IF best.siz # 0 THEN RETURN;
	FOR i IN [bc..ecb] DO IF bufx[i] # missingWidth THEN 
		BEGIN
		bufx[i] _ MulDiv[bufx[i],siz,1000];
		IF bufy # NIL THEN bufy[i] _ MulDiv[bufy[i],siz,1000];
		END;
		ENDLOOP;

	IF boundbox # NIL THEN FOR i IN [0..4) DO
		boundbox[i] _ SignedMulDiv[boundbox[i],siz,1000];
		ENDLOOP;

--And rotation if needed.
	IF rot = 0 THEN RETURN;
	IF bufy = NIL THEN MiscDefs.CallDebugger["no y buff"];
	--let cm,cs,sm,ss=nil,nil,nil,nil
	[cs,cm] _ Cos[rot];			--Get cosine
	[ss,sm] _ Cos[rot-90*60];		--and sine
	FOR i IN [bc..ecb] DO IF bufx[i] # missingWidth THEN
		BEGIN
		tl _ MulDiv[bufx[i],cm,177777B];
		IF cs#0 THEN tl _ -tl;
		sl _ MulDiv[bufy[i],sm,177777B];
		IF NOT ss#0 THEN sl _ -sl;
		xl _ tl+sl;
		tl _ MulDiv[bufy[i],cm,177777B];
		IF cs#0 THEN tl _ -tl;
		sl _ MulDiv[bufx[i],sm,177777B];
		IF ss#0 THEN sl _ -sl;
		bufx[i] _ xl;
		bufy[i] _ tl+sl;
		END;
	ENDLOOP;
END;


EncodeFace: PUBLIC PROCEDURE [weight,slope,expansion: CHARACTER] RETURNS [INTEGER] =
BEGIN
	w,s,e: INTEGER;
	SELECT weight FROM
		'M,'m,0C	=>w_0;
		'B,'b	=>w_2;
		'L,'l		=>w_4;
		ENDCASE	=>w_-100;
	SELECT slope FROM
		'I,'i			=>s_1;
		'R,'r,0C	=>s_0;
		ENDCASE	=>s_-100;
	SELECT expansion FROM
		'E,'e		=>e_12;
		'C,'c		=>e_6;
		'R,'r,0C		=>e_0;
		ENDCASE	=>e_-100;		--disallow garbage
	RETURN[w+s+e]
END;

Cos: PUBLIC PROCEDURE [theta: INTEGER] RETURNS [sign,mag: INTEGER] =
--Calculate the cosine of the given angle, and return the
-- magnitude as a fraction of #177777 (largest number)
-- Also return sign (0 if positive, -1 if negative)
BEGIN
	a,d,min: CARDINAL;

	IF theta < 0 THEN theta _ -theta;
	sign _ -InlineDefs.BITAND[(theta+90*60)/(180*60) ,1];
	d _ theta MOD 90*60;
	IF InlineDefs.BITAND[theta/(90*60) , 1] # 0 THEN d _ 90*60-d;
	min _ d MOD 60;			--Minutes part
	d _ d/60;				--Degrees part
--Now d in range 0-90 degrees

	IF d > 45 THEN
		BEGIN			--Use half-angle formulae
		IF InlineDefs.BITAND[d,1] # 0 THEN min _ min+60; --Divide angle by 2
		a _ retrievecos[d/2,min/2];
		a _ MulDiv[a,a,177777B];	-- cos^2(theta/2)
		a _ a-100000B;		-- cos^2 -1/2
		mag _ a*2;	--2 cos^2 -1
		END
	ELSE	mag _ retrievecos[d,min];
	
END;

retrievecos: PUBLIC PROCEDURE [d,min: CARDINAL] RETURNS [CARDINAL] =	--0 le d le 45
BEGIN
	CosArray: ARRAY [0..47) OF CARDINAL =
		[177777B,177765B,177727B,177645B,177537B,
		 177405B,177227B,177026B,176601B,176330B,
		 176033B,175512B,175146B,174557B,174144B,
		 173505B,173024B,172317B,171567B,171014B,
		 170216B,167376B,166532B,165645B,164735B,
		 164002B,163026B,162030B,161007B,157746B,
		 156662B,155556B,154430B,153262B,152072B,
		 150663B,147432B,146162B,144672B,143362B,
		 142032B,140463B,137075B,135471B,134045B,
		 132405B,130743B	--46 degrees because of interpolation
		];
	a: CARDINAL _ CosArray[d];
	b: CARDINAL;

	IF min # 0 THEN	--Must interpolate
		BEGIN
		b _ CosArray[d+1];
		a _ a-MulDiv[a-b,min,60];	--Careful about signs
		END;
	RETURN[a];
END;


END.
(635)\f1 2706b5B237b9B92b11B604b18B14b58B1172b14B398b6B131b12B178b12B98b12B445b12B154b15B1009b3B57b3B84b3B57b3B146b6B51b6B432b6B54b6B72b6B54b6B105b11B396b4B686b6B137b11B692b6B