DIRECTORY
CodeTimer, Commander, CommanderOps, Convert, FileNames, GGFont, GGModelTypes, GGParseIn, GGParseOut, Imager, ImagerFont, ImagerSys, ImagerTransformation, IO, PFS, Real, Rope, SimpleFeedback, SymTab;

GGFontImpl: CEDAR PROGRAM
IMPORTS CodeTimer, Commander, CommanderOps, Convert, FileNames, GGParseIn, GGParseOut, Imager, ImagerFont, ImagerSys, ImagerTransformation, IO, PFS, Real, Rope, SimpleFeedback, SymTab
EXPORTS GGFont = BEGIN

Font: TYPE = ImagerFont.Font;
FontData: TYPE = GGModelTypes.FontData;
FontDataRec: TYPE = GGModelTypes.FontDataRec;
ROPE: TYPE = Rope.ROPE;

ParseError: PUBLIC ERROR[explanation: ROPE] = CODE;

boldList: LIST OF ROPE ¬ LIST["-B", "-BI"];
italicList: LIST OF ROPE ¬ LIST["-I", "-BI"];
endList: LIST OF ROPE ¬ LIST["mrr", "mir", "brr", "bir", "mor", "bor", "bold", "italic"];

fontTable, alternateFontTable: SymTab.Ref; -- created by Init
FlushFontCache: PUBLIC PROC = {
SymTab.Erase[fontTable];
SymTab.Erase[alternateFontTable];
};

GGFontCache: Commander.CommandProc = {
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];
IF argv.argc <= 1 THEN cmd.out.PutF1["GGFontCache is %g\n", [rope[IF fontCacheOn THEN "on" ELSE "off"]] ]
ELSE {
IF Rope.Equal[argv[1], "on", FALSE] THEN fontCacheOn ¬ TRUE
ELSE IF Rope.Equal[argv[1], "off", FALSE] THEN fontCacheOn ¬ FALSE
ELSE GOTO Failed;
};
EXITS
Failed => cmd.err.PutRope["usage: GGFontCache <on | off> enables or disables Gargoyle's font cache\n"];
};

AlternateFont: PUBLIC PROC [data: FontData, font: ImagerFont.Font, op: ATOM] RETURNS [alternate: ImagerFont.Font] = {
IF font=NIL THEN RETURN[NIL];
IF op#$visible THEN RETURN[font];
IF Rope.Find[data.prefix, "pressfont", 0, FALSE]#-1 OR Rope.Find[data.prefix, "xc", 0, FALSE]#-1 THEN {
epsilon: REAL = 0.01;
ft: ImagerTransformation.FactoredTransformation;
CodeTimer.StartInt[$AlternateFontHard, $Gargoyle];
ft ¬ ImagerTransformation.Factor[data.transform];
IF ABS[ABS[ft.s.x] - ABS[ft.s.y]] < epsilon THEN {
alternate ¬ NearestTiogaFont[data.userFSF, ABS[ft.s.x], font];
}
ELSE alternate ¬ font;
CodeTimer.StopInt[$AlternateFontHard, $Gargoyle];
}
ELSE alternate ¬ font;
};

FontEntry: TYPE = REF FontEntryObj;
FontEntryObj: TYPE = RECORD [
font: Font,
scaledList: LIST OF ScaledFontEntry
];


fontCacheOn: BOOL ¬ TRUE;
FindScaledFont: PROC [name: ROPE, scale: CARD] RETURNS [scaledFont: Font ¬ NIL] = {
found: BOOL ¬ FALSE;
val: REF;
s: REAL;
font: Font;

IF scale = 0 THEN scale ¬ 1;
s ¬ scale;

IF fontCacheOn THEN {
fE: FontEntry;
[found, val] ¬ SymTab.Fetch[fontTable, name];
IF found THEN fE ¬ NARROW[val]
ELSE {
font ¬ ImagerFont.Find[name, noSubstitute ! PFS.Error, Imager.Error, Imager.Warning, ImagerSys.FileError => {font ¬ NIL; CONTINUE}];
fE ¬ NEW[FontEntryObj ¬ [font: font, scaledList: NIL]];
[] ¬ SymTab.Store[fontTable, name, fE];
};
IF fE.font = NIL THEN RETURN[NIL];
FOR list: LIST OF ScaledFontEntry ¬ fE.scaledList, list.rest UNTIL list = NIL DO
IF scale = list.first.scale THEN RETURN[list.first.font];
ENDLOOP;
scaledFont ¬ ImagerFont.Scale[fE.font, 1.0/s];
fE.scaledList ¬ CONS[[scale: scale, font: scaledFont], fE.scaledList];
}
ELSE {
font ¬ ImagerFont.Find[name, noSubstitute ! PFS.Error, Imager.Error, Imager.Warning, ImagerSys.FileError => {font ¬ NIL; CONTINUE}];
IF font = NIL THEN RETURN[NIL];
scaledFont ¬ ImagerFont.Scale[font, 1.0/s];
};
};

ScaledFontRef: TYPE = REF ScaledFontEntry;
ScaledFontEntry: TYPE = RECORD [
scale: CARD,
font: Font
];

NearestTiogaFont: PROC [userFSF: ROPE, scaleReal: REAL, default: ImagerFont.Font] RETURNS [alternate: ImagerFont.Font] = {
fE: ScaledFontRef;
TryName: PROC [name: ROPE, scale: CARD] RETURNS [alt: ImagerFont.Font ¬ NIL] = {
scaleRope: ROPE;
dashIndex: INT ¬ Rope.Find[name, "-"];

IF scale = 0 THEN RETURN;
scaleRope ¬ Convert.RopeFromCard[from: scale, base: 10, showRadix: FALSE];
altName ¬ IF dashIndex=-1
THEN Rope.Cat["xerox/tiogafonts/", name, scaleRope]
ELSE Rope.Concat["xerox/tiogafonts/", Rope.Replace[name, dashIndex, Rope.MaxLen, scaleRope]];
alt ¬ FindScaledFont[altName, scale];
};
scale: CARD;
altName: ROPE;
scale ¬ Real.Round[scaleReal];

IF fontCacheOn THEN {
found: BOOL ¬ FALSE;
val: REF;
fontName: ROPE ¬ Rope.Concat[userFSF, Convert.RopeFromCard[scale]];
[found, val] ¬ SymTab.Fetch[alternateFontTable, fontName];
IF found THEN {
fE ¬ NARROW[val];
RETURN[fE.font]; -- this is the fast case
}
ELSE {
fE ¬ NEW[ScaledFontEntry ¬ [scale: scale, font: NIL]]; -- fill in font when we GOTO Found;
[] ¬ SymTab.Store[alternateFontTable, fontName, fE];
};
};
BEGIN
alternate ¬ TryName[userFSF, scale];
IF alternate # NIL THEN GOTO Found;
alternate ¬ TryName[userFSF, scale+1];
IF alternate # NIL THEN GOTO Found;
IF scale > 0 THEN {
alternate ¬ TryName[userFSF, scale-1];
IF alternate # NIL THEN GOTO Found;
};
SELECT scale FROM
IN [4..8] => alternate ¬ TryName[userFSF, 10];
IN [9..10] => alternate ¬ TryName[userFSF, 12];
IN [14..15] => alternate ¬ TryName[userFSF, 12];
16 => alternate ¬ TryName[userFSF, 18];
20 => alternate ¬ TryName[userFSF, 18];
ENDCASE;
IF alternate # NIL THEN GOTO Found;
IF scale >= 18 THEN {
alternate ¬ default;
GOTO Found;
};
alternate ¬ TryName["Helvetica", scale];
IF alternate # NIL THEN GOTO Found;
alternate ¬ TryName["Helvetica", scale+1];
IF alternate # NIL THEN GOTO Found;
IF scale > 0 THEN {
alternate ¬ TryName["Helvetica", scale-1];
IF alternate # NIL THEN GOTO Found;
};
IF scale = 4 THEN alternate ¬ TryName["Helvetica", 6]
ELSE IF scale = 20 THEN alternate ¬ TryName["Helvetica", 18];
IF alternate # NIL THEN GOTO Found;
IF scale IN [2..17] THEN {
SimpleFeedback.PutFL[$Gargoyle, oneLiner, $Error, "Couldn't find alternate font for %g at size %g", LIST[[rope[userFSF]], [integer[scale]]]];
};
alternate ¬ default;
GOTO Found;
EXITS
Found => IF fontCacheOn THEN fE.font ¬ alternate;
END;
};


CreateFontData: PUBLIC PROC RETURNS [data: FontData] = {
data ¬ NEW[FontDataRec ¬ []];
data.substituteOK ¬ TRUE; -- bad hack here. Avoids a bogus font
};

CopyFontData: PUBLIC PROC [data: FontData, oldCopy: FontData ¬ NIL] RETURNS [newCopy: FontData] = {
newCopy ¬ IF oldCopy#NIL THEN oldCopy ELSE CreateFontData[];
IF data#NIL THEN newCopy­ ¬ data­;
IF newCopy.transform#NIL THEN newCopy.transform ¬ ImagerTransformation.Copy[newCopy.transform];
};
InitFontData: PUBLIC PROC [data: FontData] RETURNS [newData: FontData] = {
newData ¬ data;
IF newData#NIL THEN newData­ ¬ []; -- fill in from definition defaults
};


ParseFontData: PUBLIC PROC [data: FontData ¬ NIL, inStream: IO.STREAM, literalP, prefixP, familyP, faceP, transformP, scaleP, storedSizeP, designSizeP: BOOL ¬ FALSE] RETURNS [newData: FontData] = {
Inner: PROC RETURNS [error: Rope.ROPE] = {
IF literalP THEN {
scratchData.literal ¬ IO.GetTokenRope[inStream, IO.IDProc].token; -- "xerox/myFonts/FooBarFont"
scratchData.prefix ¬ FileNames.Directory[scratchData.literal]; -- "xerox/myFonts/"
scratchData.literalFSF ¬ FileNames.Tail[scratchData.literal, '/]; -- "FooBarFont"
}
ELSE {
lit: ROPE ¬ IO.GetTokenRope[inStream, IO.IDProc].token; -- "xerox/xc1-2-2/Modern-BI"
IF prefixP THEN {
scratchData.prefix ¬ FileNames.Directory[lit]; -- "xerox/xc1-2-2/"
lit ¬ FileNames.Tail[lit, '/]; -- "Modern-BI"
};
IF familyP THEN {
scratchData.userFSF ¬ lit; -- "Modern-BI"
scratchData.family ¬ Before[lit, '-]; -- "Modern
IF scratchData.family=NIL OR scratchData.family.Length[]=0 THEN RETURN["FontName SyntaxError: no font family"];
}; 
IF faceP THEN { -- means figure out the faces from the userFSF
faceRope: ROPE;
faceS: IO.STREAM  _ IO.RIS[After[scratchData.userFSF, '-]]; -- "-BI"
faceRope  _ IO.GetTokenRope[faceS, IO.IDProc ! IO.EndOfStream => CONTINUE;].token; -- -BI or SP in other cases
FOR boldRope: LIST OF ROPE _ boldList, boldRope.rest UNTIL boldRope=NIL DO
IF scratchData.bold THEN EXIT;
scratchData.bold _ Rope.Find[faceRope, boldRope.first, 0, FALSE]#-1;
ENDLOOP;
FOR italicRope: LIST OF ROPE _ italicList, italicRope.rest UNTIL italicRope=NIL DO
IF scratchData.italic THEN EXIT;
scratchData.italic _ Rope.Find[faceRope, italicRope.first, 0, FALSE]#-1;
ENDLOOP;
scratchData.faceKnown _ TRUE;
};
scratchData.comfortable _ TRUE;
};
IF transformP THEN scratchData.transform _ GGParseIn.ReadFactoredTransformationVEC[inStream];
IF scaleP THEN scratchData.scale _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12 or 20.123 or ..."
IF storedSizeP THEN scratchData.storedSize _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12 or 20.123 or ..."
IF designSizeP THEN scratchData.designSize _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12 or 20.123 or ..."
}; -- Inner

scratchData: FontData _ CreateFontData[];
errorRope: Rope.ROPE _ NIL;
BEGIN
newData _ IF data=NIL THEN CreateFontData[] ELSE data; -- prepare newData
scratchData^ _ newData^;  -- operate on scratch copy in case failure happens while parsing
errorRope _ Inner[ ! IO.Error => {errorRope _ "FontName IO Error"; GOTO Error};
IO.EndOfStream => {errorRope _ "FontName EndOfStream"; GOTO Error};
Convert.Error  => {errorRope _ "FontName Convert Error"; GOTO Error};
GGParseIn.SyntaxError => {errorRope _ "FontName SyntaxError"; GOTO Error};
];

IF errorRope#NIL THEN GOTO Error;
IF literalP THEN UserDataFromFontData[scratchData] ELSE LiteralDataFromFontData[scratchData];

newData^ _ scratchData^;
EXITS
Error => ParseError[Rope.Concat[errorRope, ": See GGFontSampler.tioga for syntax"]];
END;
};

FontDataFromFont: PUBLIC PROC [font: ImagerFont.Font] RETURNS [newData: FontData] = {
newData _ CreateFontData[];
newData.literal ¬ ImagerFont.Name[font]; -- "xerox/myFonts/FooBarFont"
newData.prefix ¬ FileNames.Directory[newData.literal]; -- "xerox/myFonts/"
newData.literalFSF ¬ FileNames.Tail[newData.literal, '/]; -- "FooBarFont"

newData.transform ¬ font.charToClient;
newData.storedSize ¬ 1.0;
newData.designSize ¬ 1.0;
UserDataFromFontData[newData];
};

FontDataFromNamelessFont: PUBLIC PROC [font: ImagerFont.Font] RETURNS [newData: FontData] = {
newFont: ImagerFont.Font _ NEW[ImagerFont.FontRep _ [
charToClient: ImagerTransformation.Scale[1.0],
typeface: font.typeface]];
newData _ CreateFontData[];
newData.storedSize _ 1.0;
newData.namelessFont _ newFont;
};


DigitProc: IO.BreakProc = {
SELECT char FROM
IO.LF, IO.CR, IO.TAB, IO.SP => RETURN [break];
'0, '1, '2, '3, '4, '5, '6, '7, '8, '9 => RETURN [break];
ENDCASE => RETURN [other];
};

NonDigitProc: IO.BreakProc = {
SELECT char FROM
'0, '1, '2, '3, '4, '5, '6, '7, '8, '9 => RETURN [other];
ENDCASE => RETURN [break];
};


LiteralDataFromFontData: PUBLIC PROC [data: FontData] = {
Inner: PROC = {
HasEndDigits: PROC RETURNS [yep: BOOL _ FALSE] = {
ENABLE IO.Error, IO.EndOfStream, Convert.Error  => {
yep _ FALSE;
CONTINUE;
};
nameStream: IO.STREAM _ IO.RIS[scratchData.family]; -- Helvetica or cmbbi66
[] _ IO.GetTokenRope[nameStream, DigitProc]; -- toss the leading alpha characters
yep _ Convert.IntFromRope[IO.GetTokenRope[nameStream, NonDigitProc].token]>0; -- get any digit characters. Assume font names indicate positive values.
};
pressPrefix: Rope.ROPE _ "xerox/pressfonts/";
fisPrefix: Rope.ROPE _ "xerox/xc1-3-3/fis/";
printPrefix: Rope.ROPE _ "xerox/xc1-2-2/";
screenPrefix: Rope.ROPE _ "xerox/tiogafonts/";
faceRope: Rope.ROPE;
SELECT TRUE FROM
(Rope.Equal[scratchData.prefix, pressPrefix, FALSE] OR Rope.Equal[scratchData.prefix, fisPrefix, FALSE]) AND scratchData.faceKnown => {
faceRope _ SELECT TRUE FROM
scratchData.bold AND scratchData.italic => "-bir",
scratchData.bold  => "-brr",
scratchData.italic => "-mir",
ENDCASE => IF HasEndDigits[] THEN "" ELSE "-mrr";
};
Rope.Equal[scratchData.prefix, printPrefix, FALSE] AND scratchData.faceKnown => {
faceRope _ SELECT TRUE FROM
scratchData.bold AND scratchData.italic => "-bold-italic",
scratchData.bold  => "-bold",
scratchData.italic => "-italic",
ENDCASE => "";

};
Rope.Equal[scratchData.prefix, screenPrefix, FALSE] => { -- derive storedSize from the font name
storedSize: REAL _ 1.5;
nameStream: IO.STREAM _ IO.RIS[scratchData.userFSF]; -- Tioga10-BI or TERMINAL
[] _ IO.GetTokenRope[nameStream, DigitProc]; -- get the leading alpha characters
storedSize _ Convert.RealFromRope[IO.GetTokenRope[nameStream, NonDigitProc].token]; -- get any digit characters
IF REAL[Real.Fix[storedSize]] # storedSize THEN ParseError["StoredSize must be an integer for screen fonts"];
scratchData.storedSize _ storedSize;  -- so things come out the right size
faceRope _ SELECT TRUE FROM
scratchData.bold AND scratchData.italic => "BI",
scratchData.bold => "B",
scratchData.italic => "I",
ENDCASE => "";
};
ENDCASE => NULL;

scratchData.literalFSF _ Rope.Concat[scratchData.family, IF HasMultiple[scratchData.family, '-] THEN NIL ELSE faceRope];
scratchData.literal _ Rope.Concat[scratchData.prefix, scratchData.literalFSF];
};

scratchData: FontData _ CreateFontData[];
errorRope: Rope.ROPE;
BEGIN
IF data=NIL THEN ParseError["NIL Font Data cannot be parsed"];
scratchData^ _ data^;  -- operate on scratch copy in case failure happens while parsing
Inner[ ! IO.Error => {errorRope _ "FontName IO Error"; GOTO Error};
IO.EndOfStream => {errorRope _ "FontName EndOfStream"; GOTO Error};
Convert.Error  => {errorRope _ "FontName Convert Error"; GOTO Error};
GGParseIn.SyntaxError => {errorRope _ "FontName SyntaxError"; GOTO Error};
];
data^ _ scratchData^;
EXITS
Error => ParseError[Rope.Concat[errorRope, ": (example: Helvetica-BI 18 for SetPressFont)"]];
END;
};

UserDataFromFontData: PUBLIC PROC [data: FontData] = {
Inner: PROC = {
userFace, literalFace: Rope.ROPE;
pressPrefix: Rope.ROPE _ "xerox/pressfonts/";
printPrefix: Rope.ROPE _ "xerox/xc1-2-2/";
screenPrefix: Rope.ROPE _ "xerox/tiogafonts/";
cmrFamily: Rope.ROPE _ "CMR";
dashBold: Rope.ROPE _ "-bold";
dashItalic: Rope.ROPE _ "-italic";

IF data.literal=NIL OR data.literalFSF=NIL THEN ERROR;
data.prefix  _ FileNames.Directory[data.literal]; -- xerox/...
SELECT TRUE FROM
Rope.Equal[data.prefix, pressPrefix, FALSE] => {
data.family _ Before[data.literalFSF, '-]; -- Helvetica or CMR
literalFace _ FileNames.Tail[data.literalFSF, '-]; -- bir or NIL
data.bold _ Rope.Equal[literalFace, "bir", FALSE] OR Rope.Equal[literalFace, "brr", FALSE];
data.italic _ Rope.Equal[literalFace, "bir", FALSE] OR Rope.Equal[literalFace, "mir", FALSE];
data.faceKnown _ TRUE;
data.comfortable _ TRUE;
userFace _ SELECT TRUE FROM
Rope.Equal[literalFace, "bir", FALSE] => "-BI",
Rope.Equal[literalFace, "brr", FALSE] => "-B",
Rope.Equal[literalFace, "mir", FALSE] => "-I",
Rope.Equal[literalFace, "mrr", FALSE] => "",
ENDCASE => "";
data.userFSF _ Rope.Concat[data.family, userFace];
};
Rope.Equal[data.prefix, printPrefix, FALSE] => {
data.family _ Before[data.literalFSF, '-]; -- Modern or urw-itcgarramond-bold-ps
data.bold _ Rope.Find[data.literalFSF, dashBold, 0, FALSE]#-1; -- has -bold
data.italic _ Rope.Find[data.literalFSF, dashItalic, 0, FALSE]#-1; -- has -italic
data.faceKnown _ TRUE;
data.comfortable _ TRUE;
userFace _ SELECT TRUE FROM
data.bold AND data.italic => "-BI",
data.bold => "-B",
data.italic => "-I",
ENDCASE => "";
data.userFSF _ Rope.Concat[data.family, userFace];
};
Rope.Equal[data.prefix, screenPrefix, FALSE] => { --Tioga10BI or TERMINAL
alphaRope, faceRope, storedSizeRope: Rope.ROPE;
storedSize: REAL _ 1.5; --, non integer default used below
nameStream: IO.STREAM _ IO.RIS[data.literalFSF]; -- Tioga10BI or TERMINAL
alphaRope _ IO.GetTokenRope[nameStream, DigitProc].token; -- get the leading alpha characters
storedSizeRope _ IO.GetTokenRope[nameStream, NonDigitProc ! IO.EndOfStream, IO.Error => CONTINUE;].token; -- get any digit characters
faceRope _ GGParseIn.ReadWord[nameStream]; -- like BI or NIL
storedSize _ Convert.RealFromRope[storedSizeRope ! Convert.Error => CONTINUE;]; -- get any digit characters
IF REAL[Real.Fix[storedSize]] # storedSize THEN ParseError["StoredSize must be an integer for screen fonts"];
data.family _ Rope.Concat[alphaRope, storedSizeRope]; -- concat alpha and numeric parts
data.scale _ data.storedSize _ storedSize;  -- so things come out the right size. Note that this overides the user input during SetFontLiteral.  The rule we use is that if you use a TiogaFont with a size in the name, like Tioga10, we derive the storedSize and scale from the name.
IF faceRope#NIL THEN faceRope _ Rope.Concat["-", faceRope];
data.userFSF _ Rope.Concat[data.family, faceRope];
data.faceKnown _ TRUE;
data.comfortable _ TRUE;
FOR boldRope: LIST OF ROPE _ boldList, boldRope.rest UNTIL boldRope=NIL DO
IF data.bold THEN EXIT;
data.bold _ Rope.Find[faceRope, boldRope.first, 0, FALSE]#-1;
ENDLOOP;
FOR italicRope: LIST OF ROPE _ italicList, italicRope.rest UNTIL italicRope=NIL DO
IF data.italic THEN EXIT;
data.italic _ Rope.Find[faceRope, italicRope.first, 0, FALSE]#-1;
ENDLOOP;
};
ENDCASE => NULL;
};

errorRope: Rope.ROPE;
BEGIN
Inner[ ! IO.Error => {errorRope _ "IO.Error during font parse"; GOTO Error};
IO.EndOfStream => {errorRope _ "IO.EndOfStream during font parse"; GOTO Error};
Convert.Error  => {errorRope _ "Convert.Error during font parse"; GOTO Error};
GGParseIn.SyntaxError => {errorRope _ "GGParseIn.SyntaxError during font parse"; GOTO Error};
];
EXITS
Error => ParseError[errorRope];
END;
};

HasMultiple: PROC [s: Rope.ROPE, char: CHAR] RETURNS [BOOL] = {
IF s=NIL THEN RETURN[FALSE]
ELSE {
found: BOOL _ FALSE;
count: INT _ 0;
pos: INT _ 0;
len: INT _ s.Length[];
IF len<2 THEN RETURN[FALSE];
DO
IF s.Fetch[pos] = char THEN IF found THEN RETURN[TRUE] ELSE found _ TRUE;
pos _ pos + 1;
IF pos >= len THEN RETURN[FALSE];
ENDLOOP;
};
};

Before: PROC [s: Rope.ROPE, char: CHAR] RETURNS [r: Rope.ROPE] = {
IF s=NIL THEN RETURN[NIL]
ELSE {
pos: INT _ 0;
len: INT _ s.Length[];
found: BOOL _ FALSE;
DO
IF s.Fetch[pos] = char THEN { -- found an instance of char in s
IF found THEN RETURN[s] ELSE {
found _ TRUE; r _ s.Substr[0, pos];
};
};
pos _ pos + 1;
IF pos = len THEN RETURN[IF found THEN r ELSE s];
ENDLOOP;
};
};

After: PROC [s: Rope.ROPE, char: CHAR] RETURNS [r: Rope.ROPE] = {
IF s=NIL THEN RETURN[NIL]
ELSE {
pos: INT _ 0;
len: INT _ s.Length[];
found: BOOL _ FALSE;
DO
IF s.Fetch[pos] = char THEN { -- found an instance of char in s
IF found THEN RETURN[s] ELSE {
found _ TRUE; r _ s.Substr[start: pos, len: Rope.MaxLen];
};
};
pos _ pos + 1;
IF pos = len THEN RETURN[IF found THEN r ELSE s];
ENDLOOP;
};
};

FontAsDetailedRope: PUBLIC PROC [font: FontData] RETURNS [detailed: Rope.ROPE] = {

};
FontPutDetailedStream: PUBLIC PROC [font: FontData, stream: IO.STREAM] = {

};
FontAsLiteralRope: PUBLIC PROC [font: FontData] RETURNS [literal: Rope.ROPE] = {
stream: IO.STREAM;
stream _ IO.ROS[];
FontPutLiteralStream[font, stream];
literal _ IO.RopeFromROS[stream];
};

FontPutLiteralStream: PUBLIC PROC [font: FontData, stream: IO.STREAM] = {
transformStream: IO.STREAM _ IO.ROS[];
transformRope: Rope.ROPE;
GGParseOut.WriteFactoredTransformationVEC[transformStream, font.transform];
transformRope _ IO.RopeFromROS[transformStream];
IO.PutFL[stream, "%g %g %g %g %g", LIST[[rope[font.literal]], [rope[transformRope]], [real[font.storedSize]], [real[font.designSize]], [rope[IF font.substituted THEN "SUBSTITUTED" ELSE ""]]] ];
};

OldParseFontData: PUBLIC PROC [inStream: IO.STREAM, prefixP, familyP, faceP, transformP, sizeP: BOOL _ FALSE] RETURNS [fail: BOOL, prefix, family, face: Rope.ROPE, transform: ImagerTransformation.Transformation, size: REAL _ 0.0] = {
ENABLE IO.Error, IO.EndOfStream, Convert.Error, GGParseIn.SyntaxError => {
fail _ TRUE;
CONTINUE; 
};
ReadWord: PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = {
WordBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = CHECKED {
SELECT char FROM
IO.LF, IO.CR, IO.TAB, IO.SP, ',, '], ') => RETURN [break];
ENDCASE => RETURN [other];
};
[word, ----] _ IO.GetTokenRope[f, WordBreakProc
!IO.EndOfStream => {word _ NIL; CONTINUE}];
};

nameStream: IO.STREAM;
fail _ FALSE;
IF prefixP THEN prefix _ IO.GetTokenRope[inStream, IO.IDProc].token; -- "xerox/myfonts/"
nameStream _ IO.RIS[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "fontOne-BI"
IF familyP THEN family _ IO.GetTokenRope[nameStream, IO.TokenProc].token; -- "fontOne"
IF faceP THEN face _ ReadWord[nameStream]; -- "-BI" (or SP)
IF transformP THEN transform _ GGParseIn.ReadFactoredTransformation[inStream];
IF sizeP THEN size _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12"
};

Init: PROC = {
fontTable _ SymTab.Create[case: FALSE]; -- cache results of ImagerFont.Find
alternateFontTable _ SymTab.Create[case: FALSE]; -- cache results of the alternate font mapping
Commander.Register["GGFontCache", GGFontCache, "GGFontCache <on | off> enables or disables Gargoyle's font cache"];
};

Init[];

END.

BGGFontImpl.mesa
Copyright Σ 1987, 1989, 1992 by Xerox Corporation.  All rights reserved.
Bier, July 11, 1993 7:56 pm PDT
Pier, July 22, 1993 6:29 pm PDT
Doug Wyatt, December 19, 1989 12:04:59 pm PST

The Font Cache
Computing Alternate (Usually Bitmap) Fonts
Takes an existing font and fontData and returns an alternate.  Only implemented op is $visible.
Returns font if no alternate is possible.  Remember that the alternate font has to work with the transformation in data.transform.
If we have a PressFont or an XC (Print) font, with a suitable data.userFSF, we concoct a TiogaFont name and see if we can Find it.  Otherwise, we punt.
Creating a FontData

Filling a FontData with valuesdefault values, from textual descriptions, from a nameless font, from an alternate font.


Utilities for Parsing
! ParseError[explanation] if something goes wrong.
Takes a FontData (if NIL, will create a new one), a stream, and BOOLEANS which denote what tokens to parse out of the stream and put in the newData.  If literalP is TRUE, then prefixP, familyP, faceP are ignored and the parser only attempts to find a literal string and parses it no further.  IF it is not literal, then if familyP then a userFSF string is parsed, and if faceP then the parser tries to extract face information from the userFSF. Fills in as many of the newData fields as possible.
faceS: IO.STREAM  _ IO.RIS[scratchData.userFSF]; -- "Modern-BI"
[] _ IO.GetTokenRope[faceS, IO.TokenProc]; -- read and discard family name "Modern"
IF transformP THEN scratchData.transform _ GGParseIn.ReadFactoredTransformation[inStream];
if you get here, you successfully parsed. Return good data.

scratchData: FontData _ CreateFontData[];  BAD IDEA
Completing a FontData from some of its parts.
! ParseError[explanation] if something goes wrong.
Constructs a literal font name from the (non NIL) values in the FontData and fills in the literal field in FontData.
This routine has the hairy specific knowledge of the formats of font names.
So far:	prefix		face 	fontName suffix

	xerox/xc1-2-2/	-B	-bold
	xerox/xc1-2-2/	-I	-italic
	xerox/xc1-2-2/	-BI	-bold-italic
	xerox/xc1-2-2/	-IB	-bold-italic
	xerox/xc1-2-2/	none	none

	xerox/pressfonts/	-B	-brr
	xerox/pressfonts/	-I	-mir
	xerox/pressfonts/	-BI	-bir
	xerox/pressfonts/	-IB	-bir
	xerox/pressfonts/	none	-mrr (unless CMR font)

	xerox/tiogafonts/	-B	Fix[size]B
	xerox/tiogafonts/	-I	Fix[size]I
	xerox/tiogafonts/	-BI	Fix[size]BI
	xerox/tiogafonts/	-IB	Fix[size]BI
	xerox/tiogafonts/	none	Fix[size]

For PressFonts Only; digits on the end indicate a "stored size" but ImagerFont produces a unit font with no face characters like -mrr; e.g. cmr60, cmbbi66, ... 
Note: this won't work for italic fonts named -bor, but both -bir and -bor extensions are found in the xerox/xc1-3-3/fis directory, so we would actually have to look at the files to disambiguate.  Yuk.
For TiogaFonts, scratchData.family includes storedSize, like Tioga10
if you get here, you successfully parsed. Return good data.
! ParseError[explanation] if something goes wrong.
Parses the literal font string in FontData, filling in the other values in FontData as possible.
xerox/pressfonts/Helvetica-bir or xerox/pressfonts/CMR63
xerox/xc1-2-2/Modern-bold-italic
xerox/xc1-2-2/urw-itcgaramond-bold-italic-ps
may look garbaged because print font names have become complex
HasMultiple returns TRUE if more than one instance of char is found in s
Before returns the part of a rope before the first instance of char.
Before returns the entire rope if char is not found OR if multiple instances of char are found
IF s.Fetch[pos] = char THEN RETURN[s.Substr[0, pos]];
After returns the part of a rope including and after the first instance of char.
After returns the entire rope if char is not found OR if multiple instances of char are found

Describing a Font Textually


For Compatibility
Used to read in a rope which is data.
WordBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = CHECKED {
SELECT char FROM
IO.TAB => RETURN [break];
IO.CR =>RETURN [break];
IO.SP => RETURN [break];
', => RETURN [break];
'] => RETURN [break];
') => RETURN [break];
ENDCASE => RETURN [other];
};
Κά–
(cedarcode) style•NewlineDelimiter

˜™Jšœ
Οe
œ=™HIcode™J™J™-J™—š
Οk	˜	Kšœš
žœ*˜Ζ
—K˜šΟn
œžœ
ž˜Kšžœ…
žœ)˜·
Kšžœ
ž˜—˜Kšœžœ˜Kšœ
žœ˜'Kšœ
žœ˜-Kšžœžœžœ
˜K˜—š
Ÿ
œžœ
žœžœžœ
˜3K˜—Kš	œ
žœ
žœ
žœžœ˜+Kš	œžœ
žœ
žœžœ˜-Kš	œ	žœ
žœ
žœžœ=˜YK˜K™Kšœ+Οc˜=šŸœžœ
žœ˜Kš
œ˜Kš
œ!˜!K˜K˜—šŸœ˜&K˜<Kš
žœžœ,žœ
žœžœ
˜išžœ˜Kšžœžœžœž˜;Kš	žœ
žœžœžœž˜BKšžœ
žœ˜K˜—š
ž˜K˜g—K˜—K˜K™*š
Ÿ
œžœ
žœ-žœžœ!˜uJ™_JšΟb(œZ™‚
Kš
žœžœ
žœ
žœ
žœ˜Kšžœ
žœ
žœ˜!Kšœžœx™—
š
žœ(žœžœ!žœžœ˜gKšœ	žœ˜Kš
œ0˜0Kš
œ2˜2K˜1š
žœ
žœ
žœžœžœ˜2Kšœ+žœ˜>K˜
—Kšžœ˜Kš
œ1˜1K˜
—Kšžœ˜K˜K˜—Kšœžœžœ˜#šœžœžœ˜Kš
œ˜Kšœžœ
žœ˜#K˜K˜K˜—Kšœ
žœžœ
˜šŸœžœžœ	žœžœžœ˜SKšœžœžœ
˜Kšœžœ
˜	Kšœžœ
˜Kš
œ˜K˜Kšžœžœ˜K˜
K˜šžœ
žœ˜Kš
œ˜Kšœ‘œ˜-Kšžœžœžœ˜šžœ˜Kšœ,žœEžœžœ˜„
Kšœžœ)žœ˜7K˜'K˜—Kš
žœžœ
žœ
žœ
žœ˜"šžœžœ
žœ,žœžœ
ž˜PKšžœžœ
Πbkœ˜9Kšžœ
˜—K˜.Kšœžœ2˜FK˜
—šžœ˜Kšœ,žœEžœžœ˜„
Kš
žœžœ
žœ
žœ
žœ˜K˜+K˜—K˜K˜—Kšœžœžœ˜*šœžœžœ˜ Kšœžœ
˜Kš
œ
˜
K˜K˜—š
Ÿœžœžœ
žœžœ!˜zKš
œ˜šŸœžœžœ	žœžœžœ˜PKšœž˜Kšœžœ˜&K˜Kšžœžœ
žœ
˜KšœCžœ˜Jšœ
žœ
˜Kšžœ/˜3KšžœY˜]—K˜%K˜—Kšœžœ
˜Kšœ	ž˜K˜K˜šžœ
žœ˜Kšœžœžœ
˜Kšœžœ
˜	Kšœ
žœ5˜CK˜:šžœžœ˜Kšœžœ˜Kš’‘#˜)K˜
—šžœ˜Kšœžœ(žœ #˜ZK˜4K˜—K˜—š
ž˜K˜$Kšžœ
žœ
žœ
žœ˜#K˜&Kšžœ
žœ
žœ
žœ˜#šžœžœ˜K˜&Kšžœ
žœ
žœ
žœ˜#K˜—šžœž˜Kšžœ,˜.Kšžœ-˜/Kšžœ.˜0K˜'K˜'Kšžœ
˜—Kšžœ
žœ
žœ
žœ˜#šžœ
žœ˜K˜Kšžœ˜K˜—K˜(Kšžœ
žœ
žœ
žœ˜#K˜*Kšžœ
žœ
žœ
žœ˜#šžœžœ˜K˜*Kšžœ
žœ
žœ
žœ˜#K˜—Kšžœžœ$˜5Kšžœ
žœžœ&˜=Kšžœ
žœ
žœ
žœ˜#šžœžœ	žœ˜Kšœdžœ%˜
K˜—K˜Kšžœ˜š
ž˜Kšœ	žœ
žœ˜1—Kšžœ
˜—K˜—K˜™K˜—šŸœžœ
žœ
žœ˜8Kšœžœ˜Kšœžœ %˜?K˜K˜—š
Ÿœžœ
žœ&žœžœ˜cKš	œ
žœ	žœ
žœ	žœ˜<Kšžœžœ
žœ˜"K•StartOfExpansion*[m: 
ImagerTransformation.Transformation]šžœžœ
žœB˜_K˜—K™™wK™—šŸœžœ
žœžœ˜JK˜Kšžœ	žœ
žœ #˜FK˜K˜—K™™K˜—šŸ
œžœ
žœžœžœ
žœSžœžœžœ˜Ε
K™2Kš	œžœ(žœ]žœ|žœΙ
™πšŸœžœ
žœžœ˜*šžœ
žœ˜Kšœžœžœ ˜_K–[s: 
ROPE, char: 
CHAR]šœ? ˜RK–[s: 
ROPE, char: 
CHAR]šœB ˜QKš
œ
˜
—šžœ˜Kšœžœžœžœ ˜Tšžœ	žœ˜Kšœ/ ˜BKšœ ˜-K˜—šžœ	žœ˜Kšœ ˜)Kšœ& 
˜0Kšžœžœ
žœžœ
žœΟtœ˜oKš
œ˜—šžœžœ .˜>Kšœ
žœ
˜Kš
œžœ
žœžœ
žœ ™?Kš
œžœ
žœžœ
žœ" ˜DKšœžœžœ
 (™SKš
œžœžœ
žœžœ
 ˜n–>[s1: 
ROPE, s2: 
ROPE, pos1: 
INT _ 0, case: 
BOOL _ TRUE]š
žœžœ
žœ
žœžœ
žœ
ž˜JKšžœžœ
žœ
˜Kšœ:žœ˜DKšžœ
˜—–>[s1: 
ROPE, s2: 
ROPE, pos1: 
INT _ 0, case: 
BOOL _ TRUE]š
žœ
žœ
žœ
žœžœžœ
ž˜RKšžœžœ
žœ
˜ Kšœ>žœ˜HKšžœ
˜—Kšœžœ
˜K˜—Kšœžœ
˜K˜—K–
[f: 
STREAM]šžœžœH™ZK–
[f: 
STREAM]šžœžœK˜]K–[r: 
ROPE]š	žœžœ*žœžœ ˜}K–[r: 
ROPE]š	žœ
žœ/žœžœ ˜‡
K–[r: 
ROPE]š	žœ
žœ/žœžœ ˜‡
Kšœ ˜—K˜Kš
œ)˜)Kšœžœžœ
˜š
ž˜Kš
œ
žœžœ
žœžœ ˜IKšœ @˜Zšœœ	žœ£œžœ˜OKšžœ£	œžœ˜CKšœ £œžœ˜EKšœ'£œžœ˜JKš
œ˜K˜—Kšžœžœ
žœ
žœ˜!Kšžœ
žœ#žœ&˜]˜Kš
‘;™;—K˜š
ž˜Kš
œT˜T—Kšžœ
˜—K˜K˜—šŸœžœ
žœžœ˜UK˜Kšœ) ˜FK–[s: 
ROPE, char: 
CHAR]šœ7 ˜JK–[s: 
ROPE, char: 
CHAR]šœ: ˜IK˜K˜&K˜K˜K˜K˜K˜—šŸœžœ
žœžœ˜]šœžœ˜5Kš
œ.˜.Kš
œ˜—Kš
œ˜Kš
œ˜Kš
œ˜K˜K˜—K™š
œ3™3K˜—šŸ	œžœ˜
procšžœž˜Lšžœ
žœžœ
žœžœ
žœžœ
žœžœ	˜.Lšœ*žœ	˜9Lšžœžœ	˜—K˜K˜—šŸœžœ˜šžœž˜Lšœ*žœ	˜9Lšžœžœ	˜—K˜—K˜š
œ-™-K˜—šŸœžœ
žœ˜9K™2Kšœ-žœD™tš
œK™KKšœ‘™%K™Kš
œ™Kš
œ™Kšœžœ
™ Kšœžœ
™ Kš
œ™K™Kš
œ™Kš
œ™Kšœžœ™Kšœžœ™Kšœ%žœ™.K™Kš
œ ™ Kš
œ ™ Kšœžœ
ž™"Kšœžœ
ž™"Kš
œ!™!K™—šŸœžœ˜š
Ÿœžœ
žœžœžœ˜2Kš
œ 
™ 
š’œ
žœžœ!˜4Kšœžœ
˜Kšžœ
˜	Kš
œ˜—Kš
œžœ
žœžœ
žœ ˜KKšœžœ& $˜QKšœžœ2 H˜–
K˜—Kšœžœ˜-Kšœžœ˜,Kšœžœ˜*Kšœžœ˜.Kšœžœ
˜šžœ
žœ
ž˜š	œ-žœžœ+žœžœ˜‡
Kš
œΘ
™Θ
šœžœ
žœ
ž˜Kšœžœ˜2Kš
œ˜Kš
œ˜K–9[base: 
ROPE, start: 
INT _ 0, len: 
INT _ 2147483647]šžœžœžœžœ˜1—Kš
œ˜—šœ,žœžœ˜Qšœžœ
žœ
ž˜Kšœžœ&˜:Kš
œ˜Kš
œ ˜ Kšžœ˜—K˜Kš
œ˜—šœ-žœ '˜`K™DKšœžœ˜Kš
œžœ
žœžœ
žœ ˜NKšœžœ& #˜PKšœ"žœ0 ˜oKšžœ
žœ$žœ>˜mKšœ& $˜Jšœžœ
žœ
ž˜Kšœžœ˜0Kš
œ˜Kš
œ˜Kšžœ˜—Kš
œ˜—Kšžœžœ
˜K˜—Kš	œ9žœ%žœ
žœ
žœ˜xKš
œN˜NK˜K˜—Kš
œ)˜)Kšœžœ
˜š
ž˜Kšžœžœ
žœ.˜>Kšœ @˜Wšœ	žœ£œžœ˜CKšžœ£	œžœ˜CKšœ £œžœ˜EKšœ'£œžœ˜JKš
œ˜Kš
‘;™;—K˜š
ž˜Kš
œ]˜]—Kšžœ
˜—K˜K˜—šŸœžœ
žœ˜6K™2Kš
œ`™`šŸœžœ˜Kšœžœ
˜!Kšœžœ˜-Kšœžœ˜*Kšœžœ˜.Kšœžœ	˜Kšœžœ˜Kšœžœ
˜"K˜K–[path: 
ROPE]šžœžœ
žœžœ
žœ
žœ
˜6Kšœ2 ˜>šžœ
žœ
ž˜šœ%žœ˜0Kšœ3ž™8Kšœ+ ˜>Kšœ3 
˜@Kšœ+žœžœ žœ˜[Kšœ-žœžœ žœ˜]Kšœžœ
˜Kšœžœ
˜šœžœ
žœ
ž˜Kšœžœ˜/Kšœžœ
˜.Kšœžœ
˜.Kšœžœ˜,Kšžœ˜—Kš
œ2˜2K˜—šœ%žœ˜0Kš
œ ™ Kš
œ,™,Kšœ+ Πbc"˜PKšœ4žœ ˜KKšœ8žœ ˜QKšœžœ
˜Kšœžœ
˜šœžœ
žœ
ž˜Kšœ
žœ˜#Kš
œ˜Kš
œ˜Kšžœ˜—š
œ2˜2Kš
‘>™>—K˜—šœ&žœ ˜IKšœ*žœ
˜/Kšœžœ "˜:Kš
œžœ
žœžœ
žœ ˜IKšœžœ, #˜]Kš
œžœ)žœžœ
žœ
 ˜…
Kšœ+ ˜<KšœDžœ ˜kKšžœ
žœ$žœ>˜mKšœ6 !˜WKšœ, μ
˜˜Kšžœ
žœ
žœ'˜;Kš
œ2˜2Kšœžœ
˜Kšœžœ
˜–>[s1: 
ROPE, s2: 
ROPE, pos1: 
INT _ 0, case: 
BOOL _ TRUE]š
žœžœ
žœ
žœžœ
žœ
ž˜JKšžœžœ
žœ
˜Kšœ3žœ˜=Kšžœ
˜—–>[s1: 
ROPE, s2: 
ROPE, pos1: 
INT _ 0, case: 
BOOL _ TRUE]š
žœ
žœ
žœ
žœžœžœ
ž˜RKšžœ
žœ
žœ
˜Kšœ7žœ˜AKšžœ
˜—K˜—Kšžœžœ
˜—K˜K˜—Kšœžœ
˜š
ž˜šœ	žœ£œžœ˜LKšžœ£œ£œžœ˜OKšœ £œžœ˜NKšœ<£œžœ˜]Kš
œ˜—š
ž˜Kš
œ˜—Kšžœ
˜—K˜K˜—šŸœžœ
žœžœžœžœ˜?Kš
œH™HKš
žœžœ
žœ
žœ
žœ
˜šžœ˜Kšœžœžœ
˜Kšœžœ˜Kšœžœ˜
Kšœžœ˜Kšžœžœ
žœ
žœ˜š
ž˜Kšžœžœ
žœžœ
žœ
žœžœ	žœ
˜IK˜Kšžœžœ
žœ
žœ˜!Kšžœ
˜—K˜—K˜K˜—šŸœžœ
žœžœžœ
žœ˜BK™DK™^Kš
žœžœ
žœ
žœ
žœ
˜šžœ˜Kšœžœ˜
Kšœžœ˜Kšœžœžœ
˜š
ž˜Kšžœžœ
žœ™5šžœžœ !˜?šžœžœ
žœžœ˜Kšœžœ˜#K˜—K˜—K˜Kšžœžœ
žœ
žœžœžœ˜1Kšžœ
˜—K˜—K˜K˜—šŸœžœ
žœžœžœ
žœ˜AKšŸœK™PKšŸœX™]Kš
žœžœ
žœ
žœ
žœ
˜šžœ˜Kšœžœ˜
Kšœžœ˜Kšœžœžœ
˜š
ž˜šžœžœ !˜?šžœžœ
žœžœ˜Kšœžœ‘œ˜9K˜—K˜—K˜Kšžœžœ
žœ
žœžœžœ˜1Kšžœ
˜—K˜—K˜K˜—K™™K™—š
Ÿœžœ
žœžœžœ˜RK˜K˜—š
Ÿœžœ
žœžœ
žœ˜JK˜K˜—š
Ÿœžœ
žœžœžœ˜PKšœžœ
žœ
˜Kšœ	žœ
žœ˜Kš
œ#˜#Kš
œ!˜!K˜K˜—š
Ÿœžœ
žœžœ
žœ˜IK–ldStream: 
STREAM _ NIL]š	œžœ
žœžœ
žœ˜&Kšœžœ
˜Kš
œK˜KKšœžœ˜0Kš
žœ!žœfžœžœžœ	˜Α
K˜—K™™K˜—šŸœžœ
žœžœ
žœ.žœžœžœžœžœ8žœ˜ι
šžœ
žœžœ7˜JKšœžœ
˜Kšžœ˜
Kš
œ˜—šŸœžœžœ
žœžœ
žœ˜;Lš
œ%™%šŸ
œžœ
žœžœžœžœžœ™Hšžœž™Lšžœ
žœžœ	™Lšžœ
žœžœ	™Lšžœ
žœžœ	™Lšœžœ	™Lšœžœ	™Lšœžœ	™Lšžœžœ	™—Lš
œ™—šŸ
œžœ
žœžœžœžœžœ˜Hšžœž˜Lšžœ
žœ
žœ
žœ
žœžœ	˜:Lšžœžœ	˜—Lš
œ˜—šœ œžœ˜/Lšœ
žœžœžœ˜+—Lš
œ˜L˜—Kšœžœ
žœ
˜Kšœžœ
˜
Kš	žœ	žœ
žœžœ ˜XKš
œ
žœ
žœ
žœžœ ˜PKš	žœ	žœ
žœžœ ˜VKšžœžœ ˜;K–
[f: 
STREAM]šžœžœ<˜NK–[r: 
ROPE]š	žœžœžœžœ ˜^Kš
œ˜—K˜šŸœžœ˜Kšœ žœ #˜KKšœ)žœ .˜_K˜sK˜K˜—K˜K˜Kšžœ
˜K˜—…—Pn~Œ