-- FontWidth.mesa
-- Written by Joe Maleson
-- Last changed by Doug Wyatt, September 29, 1980 1:44 PM

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

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

i: CARDINAL;--global loop iteration variable

Upper: PUBLIC 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: PUBLIC PROCEDURE [s: STRING] =
BEGIN
FOR i IN [0..s.length) DO s[i]←Upper[s[i]];
ENDLOOP;
END;

fwReadIndex: PUBLIC PROCEDURE[s:
StreamDefs.StreamHandle] RETURNS[POINTER TO FontWidthDefs.Index] =
BEGIN OPEN FontWidthDefs;
len: CARDINAL;
t: FontWidthDefs.RawIndex;
resultHandle: POINTER TO FontWidthDefs.Index ← SystemDefs.AllocateHeapNode[SIZE[FontWidthDefs.Index]];
str: STRING;
long: LONG CARDINAL;
strmIndex: StreamDefs.StreamIndex;
IndexTypeSelector: ARRAY [0..5) OF FontWidthDefs.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 FontWidthDefs.Index;
found,end: BOOLEAN ← FALSE;
fam: CARDINAL;
best: widths FontWidthDefs.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 FontWidthDefs.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: FontWidthDefs.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[FontWidthDefs.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 CARDINAL[bufx[i]] # 100000B 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 CARDINAL[bufx[i]] # 100000B 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
ELSEmag ← 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.