CDTextsImpl.mesa
Copyright © 1983, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, July 29, 1983 11:17 am
Last Edited by: Christian Jacobi, April 6, 1987 2:47:06 pm PDT
DIRECTORY
Ascii,
Atom,
Basics,
CDBasics,
CDTexts,
CDTextsBackdoor,
CDEvents,
CDLayers,
CDPrivate,
CDProperties,
CDVScale,
CDVPrivate,
CD,
CDIO,
FS,
Imager,
ImagerFont,
ImagerTransformation,
IO,
LRUCache,
NodeStyle,
NodeStyleFont,
Real,
Rope,
RopeHash,
RuntimeError USING [UNCAUGHT],
TerminalIO,
TokenIO,
VFonts;
CDTextsImpl: CEDAR MONITOR
IMPORTS Ascii, Atom, Basics, CD, CDBasics, CDIO, CDEvents, CDLayers, CDPrivate, CDProperties, CDTexts, CDVScale, FS, Imager, ImagerFont, ImagerTransformation, IO, LRUCache, NodeStyleFont, Real, Rope, RopeHash, RuntimeError, TerminalIO, TokenIO, VFonts
EXPORTS CDTexts, CDTextsBackdoor =
BEGIN
TextSpecific: TYPE = CDTexts.TextSpecific;
TextRec: TYPE = CDTexts.TextRec;
FontRec: TYPE = CDTexts.FontRec;
CDFont: TYPE = CDTexts.CDFont;
convertClass: PUBLIC CD.ObjectClass ← CD.RegisterObjectClass[$Text, [
internalRead: ConvertRead
]];
rigidTextClass: PUBLIC CD.ObjectClass ← CD.RegisterObjectClass[$RigidText, [
drawMe: FixDraw,
quickDrawMe: FixDraw,
internalRead: Read,
internalWrite: Write,
newLayer: ChangeLayer,
describe: Describe
]];
flipTextClass: PUBLIC CD.ObjectClass ← CD.RegisterObjectClass[$FlipText, [
drawMe: FlipDraw,
quickDrawMe: FlipDraw,
internalRead: Read,
internalWrite: Write,
newLayer: ChangeLayer,
describe: Describe
]];
FontCacheRec: TYPE = RECORD [name: Rope.ROPE, scale: INT, cdFont: CDFont←NIL];
FontHash: PROC [x: REF] RETURNS [h: CARDINAL] = {
f: REF FontCacheRec = NARROW[x];
h ← Basics.BITXOR[RopeHash.FromRope[f.name], Basics.LowHalf[LOOPHOLE[f.scale]]]
};
FontEqual: PROC [x, y: REF] RETURNS [BOOL] = {
f1: REF FontCacheRec = NARROW[x];
f2: REF FontCacheRec = NARROW[y];
RETURN [f1.scale=f2.scale AND Rope.Equal[f1.name, f2.name]]
};
fontCache: LRUCache.Handle ← LRUCache.Create[63, FontHash, FontEqual];
textCache: LRUCache.Handle ← LRUCache.Create[127, CDPrivate.Hash, TextEqual];
free: CD.Object ← NIL;
lastFont: REF FontCacheRec ← NIL;
GiveOb: ENTRY PROC [] RETURNS [ob: CD.Object] = {
ob ← free; free ← NIL;
IF ob=NIL THEN
ob ← NEW[CD.ObjectRep←[class: NIL, specific: NEW[TextRec], immutable: TRUE]];
};
TextEqual: PROC [x, y: REF] RETURNS [BOOL] = {
EqualSpec: PROC[x, y: CD.Object] RETURNS [BOOL] = INLINE {
tp1: TextSpecific = NARROW[x.specific];
tp2: TextSpecific = NARROW[y.specific];
RETURN [
Rope.Equal[tp1.text, tp2.text, TRUE]
AND tp1.cdFont.scaleI=tp2.cdFont.scaleI
AND Rope.Equal[tp1.cdFont.supposedName, tp2.cdFont.supposedName]
]
};
ob1: CD.Object = NARROW[x];
ob2: CD.Object = NARROW[y];
RETURN [ob1.class=ob2.class AND ob1.bbox=ob2.bbox AND ob1.layer=ob2.layer AND EqualSpec[ob1, ob2]]
};
Create: PUBLIC PROC [text: Rope.ROPE, font: REF ANY, layer: CD.Layer, flip: BOOLTRUE] RETURNS [ob: CD.Object] = {
ENABLE UNWIND => NULL;
WITH font SELECT FROM
cdFont: CDFont => {
insert: BOOL; used: REF;
e: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[cdFont.font, text];
w: REAL ← ImagerFont.RopeEscapement[cdFont.font, text].x;
ob ← GiveOb[];
NARROW[ob.specific, TextSpecific]^ ← [text: text, cdFont: cdFont];
ob.bbox ← [x1: -cdFont.origin.x, x2: Real.Ceiling[e.rightExtent], y1: -cdFont.origin.y, y2: cdFont.height-cdFont.origin.y];
ob.class ← IF flip THEN flipTextClass ELSE rigidTextClass;
ob.layer ← layer;
[insert: insert, used: used] ← LRUCache.Include[textCache, ob];
IF ~insert THEN {free ← ob; ob ← NARROW[used]};
};
ENDCASE => NULL
};
ImagerPrintFont: PUBLIC PROC [cdFont: CDTexts.CDFont] RETURNS [Imager.Font] = {
RETURN [InlineImagerPrintFont[cdFont]]
};
InlineImagerPrintFont: PROC [cdFont: CDTexts.CDFont] RETURNS [Imager.Font] = INLINE {
IF cdFont.substitutedFont=NIL THEN
cdFont.substitutedFont ← SubstituteTiogaFonts[cdFont.font];
RETURN [cdFont.substitutedFont];
};
FixDraw: CD.DrawProc = {
WithContext: PROC [context: Imager.Context, ob: CD.Object, layer: CD.Layer] = {
tp: CDTexts.TextSpecific = NARROW[ob.specific];
--don't clip: speed;
--Imager.ClipRectangle[context, [x: ob.bbox.x1, y: ob.bbox.y1, w: ob.bbox.x2-ob.bbox.x1, h: ob.bbox.y2-ob.bbox.y1]];
Imager.SetFont[context, (IF pr.fontSubstitution THEN InlineImagerPrintFont[tp.cdFont] ELSE tp.cdFont.font)];
Imager.SetXY[context, [0, 0]]; --always use original font offsets!
Imager.ShowRope[context, tp.text];
};
pr.drawContext[pr, WithContext, ob, trans, ob.layer]
};
FlipTransform: PUBLIC PROC [bbox: CD.Rect, orient: CD.Orientation] RETURNS [Imager.Transformation] = {
RETURN [InlineFlipTransform[bbox, orient]]
};
InlineFlipTransform: PROC [bbox: CD.Rect, orient: CD.Orientation] RETURNS [Imager.Transformation] = INLINE {
RETURN [SELECT orient FROM
--matrix multiplications done manually for speed
mirrorX, rotate90X => ImagerTransformation.Create[-1, 0, bbox.x2-bbox.x1, 0, 1, 0],
rotate180X, rotate270X => ImagerTransformation.Create[1, 0, 0, 0, -1, bbox.y2+bbox.y1],
rotate180, rotate90 => ImagerTransformation.Create[-1, 0, bbox.x2-bbox.x1, 0, -1, bbox.y2+bbox.y1],
original, rotate270 => ImagerTransformation.Create[1, 0, 0, 0, 1, 0],
--thats what it really means
original, rotate270 => ImagerTransformation.Scale[1],
mirrorX, rotate90X => ImagerTransformation.Concat[
ImagerTransformation.Translate[[bbox.x1-bbox.x2, 0]],
ImagerTransformation.Scale2[[-1, 1]]
],
rotate180X, rotate270X => ImagerTransformation.Cat[
ImagerTransformation.Translate[[bbox.x1-bbox.x2, -bbox.y2-bbox.y1]],
ImagerTransformation.Rotate[180],
ImagerTransformation.Translate[[bbox.x1-bbox.x2, 0]],
ImagerTransformation.Scale2[[-1, 1]]
],
rotate180, rotate90 => ImagerTransformation.Concat[
ImagerTransformation.Translate[[bbox.x1-bbox.x2, -bbox.y2-bbox.y1]],
ImagerTransformation.Rotate[180]
],
ENDCASE => ERROR
]
};
FlipDraw: CD.DrawProc = {
WithContext: PROC [context: Imager.Context, ob: CD.Object, layer: CD.Layer] = {
tp: CDTexts.TextSpecific = NARROW[ob.specific];
--don't clip: speed;
--Imager.ClipRectangle[context, [x: ob.bbox.x1, y: ob.bbox.y1, w: ob.bbox.x2-ob.bbox.x1, h: ob.bbox.y2-ob.bbox.y1]];
SELECT trans.orient FROM
original, rotate270 => NULL;
ENDCASE => Imager.ConcatT[context, InlineFlipTransform[ob.bbox, trans.orient]];
IF pr.fontSubstitution THEN {
f: Imager.Font ← InlineImagerPrintFont[tp.cdFont];
SELECT trans.orient FROM
mirrorX, rotate90, rotate180, rotate90X => {
--don't cache the extends: normally on display we don't do fontSubstitution
ex1: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[tp.cdFont.font, tp.text];
ex2: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[f, tp.text];
Imager.SetXY[context, [ex1.rightExtent-ex2.rightExtent, 0]];
};
--otherwise we should do the similar with leftExtend...
--but we don't care because the leftExtend error is more or less constant
--independent of rope and we want more speed.
ENDCASE => Imager.SetXY[context, [0, 0]];
Imager.SetFont[context, f];
}
ELSE {
Imager.SetFont[context, tp.cdFont.font];
Imager.SetXY[context, [0, 0]];
};
Imager.ShowRope[context, tp.text];
};
--special case if too small to be displayed reasonably
WITH pr.devicePrivate SELECT FROM
vRef: CDVPrivate.VRef => {
IF CDVScale.DesignToViewerFactor[vRef.scale]*ob.bbox.y2 <= 4 THEN {
pr.drawRect[pr, CDBasics.MapRect[[x1: ob.bbox.x1, x2: ob.bbox.x2, y1: ob.bbox.y1, y2: (ob.bbox.y1+ob.bbox.y2)/2], trans], ob.layer];
RETURN;
}
};
ENDCASE => NULL;
--normal drawing
pr.drawContext[pr, WithContext, ob, trans, ob.layer]
};
Describe: PROC [ob: CD.Object, readOnlyInstProps: CD.PropList, verbosity: NAT] RETURNS [r: Rope.ROPE] = {
tp: TextSpecific = NARROW[ob.specific];
r ← Rope.Cat["text [", tp.text, "]"];
IF ob.class#flipTextClass THEN r ← Rope.Concat["X-", r];
};
Write: CD.InternalWriteProc = {
tp: TextSpecific = NARROW[ob.specific];
CDIO.WriteRect[h, ob.bbox];
TokenIO.WriteRope[h, tp.text];
WriteFont[h, tp.cdFont];
CDIO.WriteLayer[h, ob.layer];
IF ob.class=flipTextClass THEN TokenIO.WriteInt[h, 1] ELSE TokenIO.WriteInt[h, 0]
};
Read: CD.InternalReadProc = {
ob: CD.Object; r: CD.Rect← [0,0,-1,-1];
t: Rope.ROPE; i: INT;
cdFont: REF CDTexts.FontRec; layer: CD.Layer;
IF CDIO.VersionKey[h]>15 THEN r ← CDIO.ReadRect[h]
ELSE {
[] ← CDIO.ReadPos[h];
};
t ← TokenIO.ReadRope[h];
cdFont ← ReadFont[h];
layer ← CDIO.ReadLayer[h];
i ← TokenIO.ReadInt[h];
ob ← Create[text: t, font: cdFont, layer: layer, flip: i=1];
IF r#ob.bbox AND CDBasics.NonEmpty[r] THEN FixSize[ob, r];
RETURN [ob]
};
changeTextSizeIfDifferent: BOOLFALSE;
changeMsg: BOOLFALSE;
FixSize: PROC [ob: CD.Object, r: CD.Rect] = {
IF r#ob.bbox THEN {
TerminalIO.PutRope["** size of text wrong; probably use of different font\n"];
IF ~changeMsg THEN {
TerminalIO.PutRope["** to change object sizes to the current font requirements type "" ← CDTextsImpl.changeTextSizeIfDifferent ← TRUE"" into an interpreter and read in the file again. Then set it again to FALSE\n"];
changeMsg ← TRUE;
};
IF ~changeTextSizeIfDifferent THEN ob.bbox ← r;
};
};
ReadFont: PROC [h: TokenIO.Handle] RETURNS [cdFont: REF CDTexts.FontRec] = {
format: INT ← TokenIO.ReadInt[h];
SELECT format FROM
0 => cdFont ← NARROW[CDProperties.GetPRefProp[h.properties, fontCache]];
1 => {
name: Rope.ROPE; scale: INT;
name ← TokenIO.ReadRope[h];
scale ← TokenIO.ReadInt[h];
cdFont ← MyMakeFont[name, scale, $IO];
CDProperties.PutProp[h.properties, fontCache, cdFont];
};
ENDCASE => ERROR
};
WriteFont: PROC [h: TokenIO.Handle, cdFont: CDFont] = {
--remark on caching font
-- if features are skipped the fontcache might get fooled
-- but, fonts are only used inside text objects and CDIn guarantees no Objects are skipped
IF CDProperties.GetPRefProp[h.properties, fontCache]=cdFont THEN TokenIO.WriteInt[h, 0]
ELSE {
IF cdFont.format#1 THEN ERROR;
TokenIO.WriteInt[h, 1];
TokenIO.WriteRope[h, cdFont.supposedName];
TokenIO.WriteInt[h, cdFont.scaleI];
CDProperties.PutProp[h.properties, fontCache, cdFont];
};
};
-- Fonts ========================================
UnCachedCreateFont: PROC [name: Rope.ROPE, scale: CD.Number, approx: ATOMNIL] RETURNS [cdFont: REF CDTexts.FontRec←NIL] = {
FindFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font←NIL] = {
font ← ImagerFont.Find[name !
Imager.Error => { font ← NIL;
TerminalIO.PutF["**error %g while loading font %g\n",
IO.rope[error.explanation],
IO.rope[name],
];
CONTINUE;
};
RuntimeError.UNCAUGHT => { font ← NIL;
TerminalIO.PutRopes["**unknown error while loading font ", name, "\n"];
CONTINUE;
}
];
};
IsIdentity: PROC [t: Imager.Transformation] RETURNS [BOOL] = {
RETURN [t.a=1.0 AND t.b=0.0 AND t.c=0.0 AND t.d=0.0 AND t.e=1.0 AND t.f=0.0]
};
Internalize: PROC [font: Imager.Font, scale: INT] RETURNS [cdf: REF CDTexts.FontRec←NIL] = {
IF font#NIL THEN {
e: ImagerFont.Extents;
scale ← MAX[1, scale];
IF ~IsIdentity[font.charToClient] THEN ERROR;
cdf ← NEW[CDTexts.FontRec ← [properties: CD.InitPropRef[], origin: [0, 0], xy: [0, 0], format: 1]];
cdf.scaleI ← scale;
CDProperties.PutProp[cdf.properties, $OriginalFont, font];
cdf.font ← ImagerFont.Modify[font, ImagerTransformation.Scale[scale]];
e ← ImagerFont.FontBoundingBox[cdf.font];
cdf.xy.x ← Real.Ceiling[e.leftExtent];
cdf.xy.y ← Real.Ceiling[e.descent];
cdf.height ← Real.Ceiling[e.ascent]+Real.Ceiling[e.descent];
cdf.origin.x ← Real.Ceiling[cdf.xy.x];
cdf.origin.y ← Real.Ceiling[cdf.xy.y];
}
};
FindPlaceholderFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font←NIL] = {
TerminalIO.PutRopes["**font ", name, " substituted\n"];
RETURN [VFonts.defaultFont];
};
isPlaceHolder: BOOLFALSE;
font: Imager.Font ← FindFont[name];
IF font=NIL THEN {
SELECT approx FROM
NIL => RETURN [NIL];
$old => {
font ← OldFindFont[name];
IF font#NIL THEN name ← ImagerFont.Name[font]; --to prevent bad cache entries!!
};
$IO => NULL;
ENDCASE => TerminalIO.PutRope["** bad font mode key\n"];
IF font=NIL THEN {
isPlaceHolder ← TRUE;
font ← FindPlaceholderFont[name];
};
};
IF font#NIL THEN { --exact font
cdFont ← Internalize[font, scale];
cdFont.isPlaceHolder ← isPlaceHolder;
cdFont.supposedName ← name;
RETURN
};
};
MakeFont: PUBLIC PROC [name: Rope.ROPE, scale: CD.Number] RETURNS [CDFont] = {
RETURN [MyMakeFont[name, scale, NIL]]
};
-- Old ========================================
ConvertCreateText: PROC [text: Rope.ROPE, font: REF ANY, layer: CD.Layer, key: ATOM] RETURNS [ob: CD.Object←NIL] = {
WITH font SELECT FROM
cdFont: CDFont => {
flip: BOOL ← layer=CD.commentLayer;
IF Rope.Match["*symbol*", cdFont.supposedName, FALSE] THEN flip ← FALSE;
IF Rope.Match["*gate*", cdFont.supposedName, FALSE] THEN flip ← FALSE;
IF key=$chipnsil OR key=$never THEN flip ← FALSE;
ob ← Create[text, cdFont, layer, flip]
};
ENDCASE => NULL
};
neverFlip: BOOLFALSE;
flipMsg: BOOLFALSE;
ReadEvent: CDEvents.EventProc = {
changeMsg ← flipMsg ← FALSE;
};
ConvertRead: CD.InternalReadProc = {
ob: CD.Object; sz: CD.Position; t: Rope.ROPE;
cdFont: REF CDTexts.FontRec; layer: CD.Layer;
IF CDIO.VersionKey[h]<=8 THEN RETURN [VeryOldReadText[h, NIL]];
t ← TokenIO.ReadRope[h];
layer ← CDIO.ReadLayer[h];
IF layer=CD.undefLayer AND CDIO.VersionKey[h]<=14 THEN {
layer ← CD.commentLayer;
TerminalIO.PutRope["** layer of text converted to comment\n"];
};
sz ← CDIO.ReadPos[h];
cdFont ← ReadFont[h];
ob ← ConvertCreateText[text: t, font: cdFont, layer: layer,
key: IF neverFlip THEN $never ELSE CDIO.DesignInReadOperation[h].technology.key
];
IF ~flipMsg THEN {
flipMsg ← TRUE;
TerminalIO.PutRope["**did convert text to either rigid or flip text; you can guide the conversion with either\n ← CDTextsImpl.neverFlip ← TRUE\n ← CDTextsImpl.neverFlip ← FALSE\nand repeating the input\n"];
};
--originally did compare size of text with sz
RETURN [ob]
};
OldFindFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font←NIL] = {
FindFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font←NIL] = {
font ← ImagerFont.Find[name !
Imager.Error => {font ← NIL; CONTINUE};
RuntimeError.UNCAUGHT => {font ← NIL; CONTINUE}
];
};
BasePart: PROC [name: Rope.ROPE] RETURNS [Rope.ROPE] = {
fName: Rope.ROPE;
cp: FS.ComponentPositions;
[fullFName: fName, cp: cp] ← FS.ExpandName[name: name];
RETURN [ Rope.Substr[fName, cp.base.start, cp.base.length] ]
};
FindFontOrXFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font←NIL] = {
font ← FindFont[name];
IF font=NIL THEN font ← FindFont[Rope.Concat["Xerox/TiogaFonts/", name]];
};
TryAlso: PROC [name: Rope.ROPE] RETURNS [next: Rope.ROPENIL] = {
--get rid of a B or I (for Bold or Italic)
--we don't handle ropes of length 0 and 1
IF name.Length[]>1 THEN {
ch: CHAR ← name.Fetch[name.Length[]-1];
IF ch='B OR ch='I OR ch='N THEN next ← name.Substr[0, name.Length[]-1]
}
};
ok: BOOLTRUE;
copy: Rope.ROPE ← BasePart[name];
name ← copy;
DO
font ← FindFontOrXFont[copy];
IF font#NIL THEN {
IF copy#name THEN TerminalIO.PutRope[
Rope.Cat["Font ", name, " not found; use ", copy, " instead\n"]
];
RETURN;
};
copy ← TryAlso[copy];
IF copy.IsEmpty[] THEN RETURN;
ENDLOOP;
};
VeryOldReadText: CD.InternalReadProc = {
OldReadFont: PROC [h: TokenIO.Handle] RETURNS [font: REF CDTexts.FontRec] = {
--for version<=8
name: Rope.ROPE = TokenIO.ReadRope[h];
scale: INT = MAX[TokenIO.ReadInt[h]/8, 1]; --originally used a real
ignoreHeight: CD.Number = TokenIO.ReadInt[h];
ignoreWhiteBorder: CD.Number = TokenIO.ReadInt[h];
ignoreLayerSubstitute: CD.Layer = CDIO.ReadLayer[h];
ignoreBaseOffsetX: REAL = TokenIO.ReadInt[h]/8.0;
ignoreBaseOffsetY: REAL = TokenIO.ReadInt[h]/8.0;
ignoreScaleByReplacingFontAllowed: BOOL = (1=TokenIO.ReadInt[h]);
font ← MyMakeFont[name: name, scale: scale, approx: $old];
};
ob: CD.Object;
x: INT ← -1;
y: INT ← -1;
r: Rope.ROPE;
f: ATOM;
layer: CD.Layer ← CD.undefLayer;
font: REF FontRec;
token: TokenIO.Token ← TokenIO.Read[h];
WITH token SELECT FROM
rope: TokenIO.Token.rope => r ← rope.value; -- very old
int: TokenIO.Token.int => {-- less old
x ← int.value;
y ← TokenIO.ReadInt[h];
layer ← CDIO.ReadLayer[h];
r ← TokenIO.ReadRope[h]
};
ENDCASE => ERROR TokenIO.EncodingError;
f ← TokenIO.ReadAtom[h];
IF f#NIL THEN ERROR;
font ← OldReadFont[h];
ob ← ConvertCreateText[text: r, font: font, layer: layer, key: NIL];
--originally did check size of text with x and y
RETURN [ob]
};
ChangeLayer: CD.ChangeLayerProc = {
newOb: CD.Object;
ts: CDTexts.TextSpecific ← NARROW[inst.ob.specific];
newLayer: CD.Layer ← CDLayers.AbstractToPaint[layer];
IF newLayer=CD.undefLayer AND newLayer#layer THEN RETURN [FALSE];
newOb ← Create[text: ts.text, font: ts.cdFont, layer: layer, flip: CDTexts.IsFlipText[inst.ob]];
IF newOb#NIL THEN inst.ob ← newOb;
RETURN [newOb#NIL];
};
SubstituteTiogaFonts: PUBLIC PROC [imagerFont: Imager.Font] RETURNS [printFont: Imager.Font] = {
--Translates from strike to spline fonts.
--Procedure copied from Giordano's original version in Nectarine.
--+bug fixes.
shortFName, fullFName, family, attributes: Rope.ROPE;
cp: FS.ComponentPositions;
sizePos, facePos, attributesLeng, size: INT;
face: NodeStyle.FontFace ← Regular;
printFont ← imagerFont;
[fullFName, cp] ← FS.ExpandName[ImagerFont.Name[imagerFont]];
IF Rope.Find[fullFName, "Xerox>TiogaFonts", 0, FALSE]>=0 THEN {
--Construct the old style name:
shortFName ← Rope.Substr[fullFName, cp.base.start, cp.base.length];
--Find the size and face from the old style name:
sizePos ← Rope.SkipTo[shortFName, 0, "0123456789"];
attributesLeng ← Rope.Length[shortFName]-sizePos;
attributes ← Rope.Substr[shortFName, sizePos, attributesLeng];
facePos ← Rope.SkipTo[attributes, 0, "bBiI"];
--Compute the size (assume: there always is a size):
size ← (ORD[Rope.Fetch[attributes, 0]] - ORD ['0]);
FOR i: INT IN [1..facePos) DO
size ← size * 10 + (ORD[Rope.Fetch[attributes, i]] - ORD['0])
ENDLOOP;
--Determine the face:
IF facePos#attributesLeng THEN {
it: BOOL ~ Rope.SkipTo[attributes, 0, "iI"]#attributesLeng;
b: BOOL ~ Rope.SkipTo[attributes, 0, "bB"]#attributesLeng;
SELECT TRUE FROM
it AND b => face ← BoldItalic;
it AND NOT b => face ← Italic;
NOT it AND b => face ← Bold;
ENDCASE => ERROR
};
family ← Rope.Substr[shortFName, 0, sizePos];
printFont ← NodeStyleFont.FontFromStyleParams[prefix: Atom.MakeAtom["Xerox/PressFonts/"], family: Atom.MakeAtom[family], face: face, size: size, alphabets: CapsAndLower];
IF printFont=NIL THEN RETURN [imagerFont];
printFont ← ImagerFont.Modify[printFont, imagerFont.charToClient]
};
}; 
Capitalize: PROC [r: Rope.ROPE] RETURNS [Rope.ROPE] = INLINE {
CapitalizeChar: Rope.TranslatorType = {new ← Ascii.Upper[old]};
RETURN [ Rope.Translate[base: r, translator: CapitalizeChar] ];
};
MyMakeFont: PROC [name: Rope.ROPE, scale: INT, approx: ATOMNIL] RETURNS [cdFont: CDFont] = {
f: REF FontCacheRec ← lastFont;
name ← Capitalize[name];
IF f#NIL AND f.cdFont#NIL AND f.scale=scale AND Rope.Equal[f.name, name] THEN
RETURN [f.cdFont];
f ← NEW[FontCacheRec←[scale: scale, name: name]];
f ← NARROW[LRUCache.Include[fontCache, f].used];
IF f.cdFont=NIL THEN {
cdFont ← UnCachedCreateFont[name, scale, approx];
IF cdFont=NIL OR cdFont.isPlaceHolder THEN RETURN; --no garbage in cache
f.cdFont ← cdFont
};
lastFont ← f;
RETURN [f.cdFont]
};
[] ← CDProperties.RegisterProperty[$OriginalFont, $CDTextsImpl];
CDEvents.RegisterEventProc[$ReadTechnologyPrivate, ReadEvent];
END.