TSFontImpl.mesa
Last changed by Michael Plass, November 2, 1982 10:16 am
DIRECTORY TSTypes, TSFontTable, Rope, TSFont, TSGlue;
TSFontImpl: CEDAR MONITOR
IMPORTS TSTypes, TSFontTable, Rope
EXPORTS TSFont =
BEGIN OPEN TSTypes, TSFont;
FontNotFound: PUBLIC SIGNAL [name: Rope.ROPE] RETURNS [substituteName: Rope.ROPE] = CODE;
TooManyFonts: PUBLIC SIGNAL = CODE;
Byte: TYPE = [0..256);
tableSize: NAT = 209;
table: ARRAY [0..tableSize) OF LIST OF Ref; -- in buckets by name
Reset: PUBLIC ENTRY PROCEDURE =
BEGIN ENABLE UNWIND => NULL;
FOR f:[0..tableSize) IN [0..tableSize) DO table[f] ← NIL ENDLOOP
END;
Lookup: PUBLIC ENTRY PROCEDURE[
name:Rope.ROPE,
size:Dimn ← nilDimn,
rotation: INTEGER ← 0]
RETURNS [Ref] =
BEGIN ENABLE UNWIND => NULL;
f: [0..tableSize);
r: LIST OF Ref;
fontTable:TSFontTable.Ref ← NIL;
WHILE fontTable = NIL DO
f ← Find[name];
IF table[f] = NIL THEN fontTable ← TSFontTable.Load[name]
ELSE fontTable ← table[f].first.fontTable;
IF fontTable = NIL THEN name ← SIGNAL FontNotFound[name];
ENDLOOP;
IF size = nilDimn THEN
size ← fontTable.headerInfo.designSize;
r ← table[f];
WHILE r # NIL AND (r.first.size # size OR r.first.rotation # rotation) DO
r ← r.rest;
ENDLOOP;
IF r = NIL THEN
BEGIN
t: Ref ← NEW[FontRec];
t.size ← size;
t.rotation ← rotation;
t.spaceGlue.space ← RealDimn[fontTable.parameters[spaceWidth], size];
t.spaceGlue.stretch ← RealDimn[fontTable.parameters[spaceStretch], size];
t.spaceGlue.shrink ← RealDimn[fontTable.parameters[spaceShrink], size];
t.bc ← fontTable.bc;
t.ec ← fontTable.ec;
t.metrics ← NEW[MetricSequenceRec[t.ec-t.bc+1]];
FOR i: NAT IN [0..t.ec-t.bc] DO
OPEN fontTable^;
info: TSFontTable.FInfoEntry ← fInfoTable[LOOPHOLE[t.bc,Byte]+i];
t.metrics[i].width ← RealDimn[widthTable[info.widthIndex], size];
t.metrics[i].height ← RealDimn[heightTable[info.heightIndex], size];
t.metrics[i].depth ← RealDimn[depthTable[info.depthIndex], size];
ENDLOOP;
t.fontTable ← fontTable;
table[f] ← r ← CONS[t,table[f]];
END;
RETURN[r.first];
END;
totalFinds, totalProbes: LONG INTEGER ← 0; -- some statistics
Find: PROCEDURE [name: Rope.ROPE]
RETURNS [f:[0..tableSize)] =
BEGIN
probes: NAT ← 0;
f ← Hash[name];
THROUGH [0..tableSize] UNTIL table[f]=NIL OR
Rope.Equal[table[f].first.fontTable.name,name,FALSE] DO
IF f=0 THEN f←tableSize-1 ELSE f ← f-1;
probes ← probes+1;
ENDLOOP;
IF probes > tableSize THEN ERROR TooManyFonts;
totalFinds ← totalFinds+1;
totalProbes ← totalProbes + probes;
END;
Hash: PROCEDURE [name: Rope.ROPE] RETURNS [[0..tableSize)] =
BEGIN
g: NAT ← 0;
HashChar: SAFE PROC [c: CHAR] RETURNS [BOOLEAN ← FALSE] = {
g ← 5*g + LOOPHOLE[c,[0..256)];
IF g > (LAST[NAT]-255)/5 THEN g ← g MOD tableSize
};
[] ← Rope.Map[base: name, action: HashChar];
RETURN[g MOD tableSize]
END;
ParcFontSpecification: PUBLIC PROCEDURE [f:Ref]
RETURNS [family: Rope.ROPE,
micaSize: NAT,
face: [0..255],
rotation: INTEGER] =
BEGIN
OPEN f.fontTable^;
family ← headerInfo.family;
face ← headerInfo.face;
micaSize ← DimnInt[f.size,mica];
rotation ← f.rotation;
END;
CharDimensions: PUBLIC PROCEDURE [r: Ref, c: CHAR] RETURNS [extent: Dimensions] =
BEGIN
IF c IN [r.bc..r.ec] THEN {
m: MetricRec ← r.metrics[c - r.bc];
extent[right] ← m.width;
extent[left] ← zeroDimn;
extent[up] ← m.height;
extent[down] ← m.depth;
}
ELSE extent ← [zeroDimn, zeroDimn, zeroDimn, zeroDimn];
END;
Width: PUBLIC PROCEDURE [r: Ref, c: CHAR] RETURNS [TSTypes.Dimn] =
{RETURN[IF c IN [r.bc..r.ec] THEN r.metrics[c - r.bc].width ELSE zeroDimn]};
CharItalicCorr: PUBLIC PROCEDURE [r: Ref, c: CHAR] RETURNS [TSTypes.Dimn] =
BEGIN OPEN r.fontTable^;
IF c IN [bc..ec] THEN {
info: TSFontTable.FInfoEntry ← fInfoTable[LOOPHOLE[c,Byte]];
RETURN[RealDimn[charIcTable[info.charIcIndex], r.size]];
}
ELSE RETURN[zeroDimn];
END;
SpaceGlue: PUBLIC PROCEDURE [r: Ref] RETURNS [g: TSGlue.Glue] = {g ← r.spaceGlue};
END.
Michael Plass, September 7, 1982 3:55 pm. Reworked metric fetching to avoid rescaling.
Michael Plass, September 15, 1982 9:36 am. ENABLE UNWIND => NULL.
Michael Plass, November 2, 1982 10:17 am. CEDARized.