NodeStyleFontImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Michael Plass, May 23, 1985 1:51:57 pm PDT
Doug Wyatt, May 26, 1985 1:43:21 pm PDT
Rick Beach, June 3, 1985 9:49:22 pm PDT
DIRECTORY
Atom USING [GetPName],
Convert USING [AppendInt],
Imager USING [Error],
ImagerFont USING [Find, Font, Scale],
NodeStyle USING [FontAlphabets, FontFace],
NodeStyleFont USING [],
Real USING [Round],
RefText USING [AppendRope, AppendTextRope, ObtainScratch, ReleaseScratch],
Rope USING [Equal, Find, FromRefText, Match, ROPE, Size],
VFonts USING [DefaultFont];
NodeStyleFontImpl: CEDAR PROGRAM
IMPORTS Atom, Convert, Real, Rope, RefText, Imager, ImagerFont, VFonts
EXPORTS NodeStyleFont
~ BEGIN
ROPE: TYPE ~ Rope.ROPE;
FontAlphabets: TYPE ~ NodeStyle.FontAlphabets;
FontFace: TYPE ~ NodeStyle.FontFace;
Font: TYPE ~ ImagerFont.Font;
PrefixKind: TYPE ~ RECORD [
pattern: ROPE,
sizeInName: BOOL,
faceEncoding: FaceEncoding
];
FaceEncoding: TYPE ~ {boldItalic, bir, bi};
prefixKinds: LIST OF PrefixKind ← LIST[
[pattern: "xerox/tiogafonts/", sizeInName: TRUE, faceEncoding: bi],
[pattern: "xerox/pressfonts/", sizeInName: FALSE, faceEncoding: bir],
[pattern: "xerox/altofonts/", sizeInName: TRUE, faceEncoding: bi],
[pattern: "xerox/xc*", sizeInName: FALSE, faceEncoding: boldItalic]
];
AppendFontName: PROC [text: REF TEXT, prefix: ATOM, family: ATOM, face: FontFace, size: REAL, alphabets: FontAlphabets] RETURNS [new: REF TEXT, sizeInName: BOOL] ~ {
fam: ROPE ~ Atom.GetPName[family];
pre: ROPEIF prefix#NIL THEN Atom.GetPName[prefix] ELSE NIL;
faceEncoding: FaceEncoding ← boldItalic;
IF Rope.Find[fam, "/"] >= 0 THEN {
text ← RefText.AppendRope[text, fam];
RETURN [text, FALSE];
};
IF pre = NIL OR Rope.Size[pre] = 0 THEN pre ← "xerox/tiogafonts/";
sizeInName ← FALSE;
FOR p: LIST OF PrefixKind ← prefixKinds, p.rest UNTIL p=NIL DO
IF Rope.Match[p.first.pattern, pre, FALSE] THEN {
sizeInName ← p.first.sizeInName;
faceEncoding ← p.first.faceEncoding;
};
ENDLOOP;
text ← RefText.AppendRope[text, pre];
text ← RefText.AppendRope[text, fam];
IF sizeInName THEN {
text ← Convert.AppendInt[text, Real.Round[size]];
};
SELECT faceEncoding FROM
boldItalic => {
IF face=Bold OR face=BoldItalic THEN text ← RefText.AppendTextRope[text, "-bold"];
IF face=Italic OR face=BoldItalic THEN text ← RefText.AppendTextRope[text, "-italic"];
};
bir => {
text ← RefText.AppendTextRope[text, SELECT face FROM Bold => "-BRR", Italic => "-MIR", BoldItalic => "-BIR", ENDCASE => "-MRR"];
};
bi => {
IF face=Bold OR face=BoldItalic THEN text ← RefText.AppendTextRope[text, "B"];
IF face=Italic OR face=BoldItalic THEN text ← RefText.AppendTextRope[text, "I"];
};
ENDCASE => ERROR;
new ← text;
};
FontNameFromStyleParams: PUBLIC PROC [prefix: ATOM, family: ATOM, face: FontFace, size: REAL, alphabets: FontAlphabets] RETURNS [name: ROPE, scale: REAL] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ← scratch;
sizeInName: BOOLFALSE;
[text, sizeInName] ← AppendFontName[text, prefix, family, face, size, alphabets];
name ← Rope.FromRefText[text];
IF sizeInName THEN scale ← 1.0 ELSE scale ← size;
RefText.ReleaseScratch[scratch];
};
nTrys: NAT ~ 4;
tryDelta: ARRAY [0..nTrys) OF REAL ← [0, -0.999, 0.999, -1.998];
families: LIST OF LIST OF ATOMLIST[
LIST[$Tioga, $Laurel, $TimesRoman],
LIST[$TimesRoman, $Classic],
LIST[$Helvetica, $Modern, $TimesRoman],
LIST[$Modern, $Helvetica],
LIST[$Classic, $TimesRoman],
LIST[$Gacha, $Helvetica]
];
SubstituteFamilies: PROC [family: ATOM] RETURNS [LIST OF ATOM] ~ {
fam: ROPE ~ Atom.GetPName[family];
FOR f: LIST OF LIST OF ATOM ← families, f.rest UNTIL f=NIL DO
k: ATOM ← f.first.first;
IF family = k OR Rope.Equal[fam, Atom.GetPName[k]] THEN RETURN [f.first];
ENDLOOP;
RETURN [NIL];
};
Replacement: PROC [prefix: ATOM, family: ATOM, face: FontFace, size: REAL, alphabets: FontAlphabets] RETURNS [font: ImagerFont.Font] ← NIL;
Plug with debugger for experimentation purposes.
horribleHackForTioga10: BOOLTRUE;
FontFromStyleParams: PUBLIC PROC [prefix: ATOM, family: ATOM, face: FontFace, size: REAL, alphabets: FontAlphabets] RETURNS [font: ImagerFont.Font ← NIL] ~ {
IF Replacement # NIL THEN {
font ← Replacement[prefix, family, face, size, alphabets];
};
IF font = NIL THEN {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ← scratch;
sizeInName: BOOLFALSE;
families: LIST OF ATOMNIL;
trialFamily: ATOM ← family;
IF horribleHackForTioga10 AND (family=$tioga OR family=$Tioga) AND (size NOT IN [9.5..10.5]) THEN {
trialFamily ← family ← $TimesRoman;
};
WHILE font = NIL AND trialFamily # NIL DO
FOR try: NAT IN [0..nTrys) WHILE font=NIL DO
trialSize: REAL ← size + tryDelta[try];
text.length ← 0;
[text, sizeInName] ← AppendFontName[text, prefix, trialFamily, face, trialSize, alphabets];
TRUSTED {
font ← ImagerFont.Find[LOOPHOLE[text] ! Imager.Error => CONTINUE];
};
IF NOT sizeInName THEN EXIT;
ENDLOOP;
IF font = NIL THEN {
IF families = NIL THEN families ← SubstituteFamilies[family];
IF families # NIL THEN {
families ← families.rest;
};
trialFamily ← IF families=NIL THEN NIL ELSE families.first;
};
ENDLOOP;
IF font = NIL THEN {
font ← VFonts.DefaultFont[font];
sizeInName ← TRUE;
};
IF NOT sizeInName THEN {
font ← ImagerFont.Scale[font, size];
};
RefText.ReleaseScratch[scratch];
};
};
END.
CHANGE LOG
Rick Beach, June 3, 1985 9:48:52 pm PDT
changes to: AppendFontName to ignore case when matching prefixes