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, October 6, 1987 6:05:41 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:
BOOL←
TRUE]
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]
],
};
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: BOOL ← FALSE;
changeMsg: BOOL ← FALSE;
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 ========================================
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]
};
UnCachedCreateFont:
PROC [name: Rope.
ROPE, scale:
CD.Number, approx:
ATOM ←
NIL]
RETURNS [cdFont:
REF CDTexts.FontRec←
NIL] = {
isPlaceHolder: BOOL ← FALSE;
font: Imager.Font ← NIL;
FindFont:
PROC [name: Rope.
ROPE] = {
font ← ImagerFont.Find[name !
Imager.Error => {
TerminalIO.PutF["**error %g while loading font %g\n",
IO.rope[error.explanation],
IO.rope[name],
];
font ← NIL;
CONTINUE;
};
Imager.Warning => {
TerminalIO.PutF["**Imager-warning %g while loading font %g\n",
IO.rope[error.explanation],
IO.rope[name],
];
isPlaceHolder ← TRUE;
IF approx=$IO THEN RESUME;
TerminalIO.PutRope["Font not used to prevent future conversion problems\n"];
font ← NIL;
CONTINUE;
};
RuntimeError.
UNCAUGHT => {
TerminalIO.PutRopes["**unknown error while loading font ", name, "\n"];
font ← NIL;
CONTINUE;
}
];
};
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];
}
};
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;
TerminalIO.PutRopes["**font ", name, " substituted\n"];
font ← VFonts.defaultFont;
};
};
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: BOOL ← FALSE;
flipMsg: BOOL ← FALSE;
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.
ROPE←
NIL] = {
--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: BOOL ← TRUE;
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:
ATOM←
NIL]
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.