<> <> <> <> <<>> 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>> < ImagerTransformation.Scale[1],>> < ImagerTransformation.Concat[>> <> <> <<],>> < ImagerTransformation.Cat[>> <> <> <> <> <<],>> < ImagerTransformation.Concat[>> <> <> <<],>> 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: 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.