-- PressFontWidths.mesa, edit by Johnsson; July 9, 1980 2:09 PM
-- converted to Laurel by Ken Pier, July 30, 1981 9:17 AM
-- fixed INTEGER[p] in ScaleThings, August 5, 1981 11:11 AM
-- added FreeCacheEntry, August 10, 1981 5:10 PM
-- converted to Laurel 6.1 by Ken Pier, May 17, 1983 10:39 AM
DIRECTORY
InlineDefs USING [LongDiv, LongMult],
Press USING [
FontSlope, FontWeight, magicNonPrintingWidth, Mica,
micasPerInch, Points, pointsPerInch],
PressUtilities USING [],
intCommon USING [user],
PrintDefs USING[PError, DestroyS],
Core: FROM "Core" USING [--FreeCacheEntry,--Login ],
csD: FROM "CoreStreamDefs";
PressFontWidths: PROGRAM
IMPORTS intCommon, PrintDefs, InlineDefs, csD, Core
EXPORTS PressUtilities =
BEGIN
FontSlope: TYPE = Press.FontSlope;
FontWeight: TYPE = Press.FontWeight;
Mica: TYPE = Press.Mica;
Points: TYPE = Press.Points;
-- bug in us, or file in wrong format
FontName: TYPE = PACKED ARRAY [0..20) OF BYTE;
FontFace: TYPE = [0..2*3*3); -- this wasn't my idea
BYTE: TYPE = [0..377B];
-- see [MAXC]<Press>FontFormats.bravo
-- if index.size=0, then numbers need to be scaled by points*2540/72000
IX: TYPE = MACHINE DEPENDENT RECORD [type: [0..17B), length: [0..7777B]];
IXN: TYPE = MACHINE DEPENDENT RECORD [e: IX, code: WORD, name: FontName];
SDTIX: TYPE = MACHINE DEPENDENT RECORD [
e: IX,
code, face: BYTE,
bc, ec: CHARACTER,
size: Points,
rotation: INTEGER,
x1, location, x2, length: CARDINAL]; -- position in file
WidthSegment: TYPE = MACHINE DEPENDENT RECORD [
fBBox, fBBoy, fBBdx, fBBdy: WORD, xFeed, yFeed: BOOLEAN, xxx: [0..37777B]];
ComputeFontFace: PROCEDURE [w: FontWeight, s: FontSlope]
RETURNS [ff: FontFace] =
BEGIN
ff ← 0;
SELECT w FROM
medium => ff ← ff + 0;
bold => ff ← ff + 2;
--light => ff ← ff+4;
ENDCASE => PrintDefs.PError[BadParameters];
SELECT s FROM
regular => ff ← ff + 0;
italic => ff ← ff + 1;
ENDCASE => PrintDefs.PError[BadParameters];
--SELECT expansion FROM
-- regular => ff ← ff+0;
-- condensed => ff ← ff+6;
-- expanded => ff ← ff+12;
-- ENDCASE => PrintDefs.PError[BadParameters];
END;
FindFontWidths: PUBLIC PROCEDURE [
family: STRING, points: Points, weight: FontWeight, slope: FontSlope,
widths: POINTER TO ARRAY CHARACTER OF Mica]
RETURNS [fBBox, fBBoy, fBBdx, fBBdy: Mica] =
BEGIN
ScaleThings: PROCEDURE [p: CARDINAL] RETURNS [Mica] =
BEGIN OPEN InlineDefs;
pp: INTEGER ← LOOPHOLE[p];
IF pp = Press.magicNonPrintingWidth THEN RETURN[pp];
IF index.size # 0 THEN RETURN[pp];
-- This will overflow at about 200 points.
IF p IN [0..77777B] THEN RETURN[LongDiv[LongMult[254*points, pp], 7200]];
RETURN[-LongDiv[LongMult[254*points, -pp], 7200]];
END;
ff: FontFace = ComputeFontFace[weight, slope];
i: CARDINAL;
c: CHARACTER;
code: WORD;
nameFound, indexFound: BOOLEAN ← FALSE;
pointSizeInMicas: Mica;
name: FontName;
e: IX;
header: IXN;
index: SDTIX;
width: WidthSegment;
x: WORD;
s: csD.StreamHandle ← NIL;
BEGIN ENABLE UNWIND => {s ← PrintDefs.DestroyS[s];};
Core.Login[@intCommon.user];
s ← csD.OpenFromName["Fonts.widths"L, word, read];
--Core.FreeCacheEntry["Fonts.widths"L];--
BEGIN OPEN InlineDefs; -- else overflows at about 25 points
pointSizeInMicas ← LongDiv[
LongMult[Press.micasPerInch, points], Press.pointsPerInch];
END;
-- copy over the family name into Fonts.Widths format
IF family.length~ IN (0..19] THEN PrintDefs.PError[BadParameters];
FOR i IN [0..20) DO name[i] ← 0; ENDLOOP;
name[0] ← family.length;
FOR i IN [0..family.length) DO
SELECT family[i] FROM
IN ['A..'Z] => name[i + 1] ← LOOPHOLE[family[i]];
IN ['a..'z] => name[i + 1] ← LOOPHOLE[family[i], BYTE] - 40B;
ENDCASE => PrintDefs.PError[BadParameters];
ENDLOOP;
DO
IF csD.ReadBlock[s, @e, 0, SIZE[IX]] = 0
THEN PrintDefs.PError[ErrorReadingFontWidths];
SELECT e.type FROM
0 => EXIT;
1 =>
BEGIN
IF e.length # SIZE[IXN] THEN PrintDefs.PError[ErrorReadingFontWidths];
IF csD.ReadBlock[s, @header + 1, 0, SIZE[IXN] - 1] = 0 THEN
PrintDefs.PError[ErrorReadingFontWidths];
IF EqualName[@name, @header.name] THEN
BEGIN code ← header.code; nameFound ← TRUE; END;
END;
4 =>
BEGIN
IF e.length # SIZE[SDTIX] THEN PrintDefs.PError[ErrorReadingFontWidths];
IF csD.ReadBlock[s, @index + 1, 0, SIZE[SDTIX] - 1] = 0 THEN
PrintDefs.PError[ErrorReadingFontWidths];
IF nameFound AND code = index.code AND ff = index.face AND
index.rotation = 0 AND (index.size = 0 OR INTEGER[index.size] =
pointSizeInMicas) THEN BEGIN indexFound ← TRUE; EXIT; END;
END;
ENDCASE => PrintDefs.PError[ErrorReadingFontWidths];
ENDLOOP;
IF ~indexFound THEN PrintDefs.PError[FontNotInFontsDotWidths];
IF index.x1 # 0 OR index.x2 # 0 THEN
PrintDefs.PError[ErrorReadingFontWidths];
-- position file to starting byte of our info
csD.SetPosition[s, index.location];
IF csD.ReadBlock[s, @width, 0, SIZE[WidthSegment]] = 0 THEN
PrintDefs.PError[ErrorReadingFontWidths];
fBBox ← ScaleThings[width.fBBox];
fBBoy ← ScaleThings[width.fBBoy];
fBBdx ← ScaleThings[width.fBBdx];
fBBdy ← ScaleThings[width.fBBdy];
IF width.xFeed THEN
BEGIN
x ← ScaleThings[csD.Read[s]];
FOR c IN [index.bc..index.ec] DO widths[c] ← x; ENDLOOP;
END
ELSE
BEGIN
FOR c IN [index.bc..index.ec] DO widths[c] ← ScaleThings[csD.Read[s]]; ENDLOOP;
END;
s ← PrintDefs.DestroyS[s];
END;-- of ENABLED BEGIN
END;-- of PROC FindFontWidths
EqualName: PROCEDURE [n1, n2: POINTER TO FontName] RETURNS [BOOLEAN] =
BEGIN
i: CARDINAL;
FOR i IN [0..20) DO IF n1[i] # n2[i] THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE];
END;
END.
--Former Errors
FontNotInFontsDotWidths: PUBLIC ERROR = CODE;
ErrorReadingFontWidths: PUBLIC ERROR = CODE;