<> <> <> <> <> <<>> DIRECTORY CDTexts, CDProperties, CD, CDIO, FS, Imager, ImagerFont, ImagerTransformation, IO, Real, Rope, RuntimeError USING [UNCAUGHT], SymTab, TerminalIO, TokenIO, VFonts; CDTextsImpl: CEDAR MONITOR IMPORTS CD, CDIO, CDProperties, FS, Imager, ImagerFont, ImagerTransformation, IO, Real, Rope, RuntimeError, SymTab, TerminalIO, TokenIO, VFonts EXPORTS CDTexts = BEGIN TextPtr: TYPE = CDTexts.TextPtr; TextRec: TYPE = CDTexts.TextRec; FontRec: TYPE = CDTexts.FontRec; CDFont: TYPE = CDTexts.CDFont; textClass: PUBLIC CD.ObjectClass _ CD.RegisterObjectClass[$Text, [ drawMe: DrawMeForTexts, quickDrawMe: DrawMeForTexts, internalRead: ReadText, internalWrite: WriteText, describe: Describe, origin: Origin ]]; fontTab: SymTab.Ref _ SymTab.Create[mod: 31, case: FALSE]; CreateText: PUBLIC PROC [text: Rope.ROPE, font: REF READONLY ANY, layer: CD.Layer _ CD.undefLayer] RETURNS [CD.Object] = BEGIN WITH font SELECT FROM cdFont: CDFont => { e: ImagerFont.Extents _ ImagerFont.RopeBoundingBox[cdFont.font, text]; w: REAL _ ImagerFont.RopeWidth[cdFont.font, text].x; tp: TextPtr _ NEW[TextRec _ [text: text, cdFont: cdFont]]; tob: CD.Object _ NEW[CD.ObjectRep_[ size: [cdFont.origin.x+Up[e.rightExtent], cdFont.height], class: textClass, specificRef: tp, layer: layer ]]; RETURN [tob] }; < {>> <> <> <<};>> ENDCASE => RETURN [NIL] END; Origin: PROC [ob: CD.Object] RETURNS [o: CD.Position] = BEGIN o _ NARROW[ob.specificRef, TextPtr].cdFont.origin; END; DrawMeForTexts: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN DrawTextInContext: PROC [context: Imager.Context, ob: CD.Object, layer: CD.Layer] = BEGIN tp: CDTexts.TextPtr = NARROW[ob.specificRef]; <<--don't clip; speeeed;>> <<--Imager.ClipRectangle[context, [x: 0, y: 0, w: ob.size.x, h: ob.size.y]];>> IF pr.specialFonts THEN { --use substituted font font: CDTexts.CDFont; WITH CDProperties.GetListProp[pr.properties^, $FontExchange] SELECT FROM xp: REF PROC [CDTexts.CDFont] RETURNS [CDTexts.CDFont] => font _ xp^[tp.cdFont]; ENDCASE => font _ tp.cdFont; Imager.SetFont[context, font.font]; } ELSE Imager.SetFont[context, tp.cdFont.font]; --normal case Imager.SetXY[context, tp.cdFont.xy]; --always use original font offsets! Imager.ShowRope[context, tp.text]; END; pr.drawContext[pr, DrawTextInContext, inst.ob, pos, orient, inst.ob.layer] END; catchOnFontProblem: BOOL _ TRUE; FindExactFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font_NIL] = BEGIN font _ ImagerFont.Find[name ! Imager.Error => { font _ NIL; TerminalIO.WriteRope[Rope.Cat["**error while loading font: ", error.explanation, "\n"]]; IF catchOnFontProblem THEN CONTINUE; }; RuntimeError.UNCAUGHT => { font _ NIL; TerminalIO.WriteRope[Rope.Cat["**unknown error while loading font ", name, "\n"]]; IF catchOnFontProblem THEN CONTINUE; } ]; END; FindOldFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font_NIL] = BEGIN 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 _ FindExactFont[name]; IF font=NIL THEN font _ FindExactFont[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)>> BEGIN <<--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] } } END; <<--FindOldFont>> ok: BOOL _ TRUE; copy: Rope.ROPE _ BasePart[name]; name _ copy; DO font _ FindFontOrXFont[copy]; IF font#NIL THEN { IF copy#name THEN TerminalIO.WriteRope[ Rope.Cat["Font ", name, " not found; use ", copy, " instead\n"] ]; RETURN; }; copy _ TryAlso[copy]; IF copy.IsEmpty[] THEN RETURN; ENDLOOP; END; FindSomeFont: PROC [name: Rope.ROPE] RETURNS [font: Imager.Font_NIL] = BEGIN TerminalIO.WriteRopes["**font ", name, " substituted\n"]; RETURN [VFonts.defaultFont]; END; OldReadText: CD.InternalReadProc --PROC [] RETURNS [Object]-- = BEGIN OldReadFont: PROC [] RETURNS [font: REF CDTexts.FontRec] = <<--for version<=8>> BEGIN name: Rope.ROPE = TokenIO.ReadRope[]; scale: INT = MAX[TokenIO.ReadInt[]/8, 1]; --originally used a real ignoreHeight: CD.Number = TokenIO.ReadInt[]; ignoreWhiteBorder: CD.Number = TokenIO.ReadInt[]; ignoreLayerSubstitute: CD.Layer = CDIO.ReadLayer[]; ignoreBaseOffsetX: REAL = TokenIO.ReadInt[]/8.0; ignoreBaseOffsetY: REAL = TokenIO.ReadInt[]/8.0; ignoreScaleByReplacingFontAllowed: BOOL = (1=TokenIO.ReadInt[]); font _ MyMakeFont1[name: name, scale: scale, approx: $compat]; END; ob: CD.Object; x: INT _ -1; y: INT _ -1; r: Rope.ROPE; f: ATOM; lay: CD.Layer _ CD.undefLayer; font: REF FontRec; token: TokenIO.Token _ TokenIO.ReadToken[]; IF token.kind=rope THEN { <<-- very old>> r _ NARROW[token.ref]; } ELSE { <<-- less old>> x _ NARROW[token.ref, REF INT]^; y _ TokenIO.ReadInt[]; lay _ CDIO.ReadLayer[]; r _ TokenIO.ReadRope[] }; f _ TokenIO.ReadAtom[]; IF f#NIL THEN ERROR; font _ OldReadFont[]; ob _ CreateText[text: r, font: font, layer: lay]; IF x>0 OR y>0 THEN IF x#ob.size.x OR y#ob.size.y THEN TerminalIO.WriteRope["** size of text wrong; probably use of different font\n"]; RETURN [ob] END; changeTextSizeIfDifferent: BOOL _ FALSE; msg: BOOL _ FALSE; msg2: BOOL _ FALSE; ReadText: CD.InternalReadProc = BEGIN ob: CD.Object; sz: CD.Position; r: Rope.ROPE; cdFont: REF CDTexts.FontRec; lay: CD.Layer; IF CDIO.VersionKey[]<=8 THEN RETURN [OldReadText[]]; r _ TokenIO.ReadRope[]; lay _ CDIO.ReadLayer[]; <> IF (lay=CD.undefLayer) OR (lay=CD.errorLayer) THEN { lay _ CD.commentLayer; IF ~msg2 THEN { TerminalIO.WriteRope ["** converting text to use the new comment layer\n"]; msg2 _ TRUE } }; -- layer conversion sz _ CDIO.ReadPos[]; cdFont _ ReadFont[]; ob _ CreateText[text: r, font: cdFont, layer: lay]; IF sz#ob.size THEN { TerminalIO.WriteRope["** size of text wrong; probably use of different font\n"]; IF ~msg THEN { TerminalIO.WriteRope["** 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"]; msg_TRUE; }; IF ~changeTextSizeIfDifferent THEN ob.size _ sz; }; RETURN [ob] END; ReadFont: PROC [] RETURNS [cdFont: REF CDTexts.FontRec] = BEGIN format: INT _ TokenIO.ReadInt[]; SELECT format FROM 1 => { name: Rope.ROPE; scale: INT; name _ TokenIO.ReadRope[]; scale _ TokenIO.ReadInt[]; cdFont _ MyMakeFont1[name, scale, $IO]; }; ENDCASE => ERROR END; WriteFont: PROC [cdFont: CDFont] = BEGIN TokenIO.WriteInt[cdFont.format]; IF cdFont.format=1 THEN { TokenIO.WriteRope[cdFont.supposedName]; TokenIO.WriteInt[cdFont.scaleI]; } ELSE ERROR; END; WriteText: CD.InternalWriteProc -- PROC [me: Object] -- = BEGIN tp: TextPtr = NARROW[me.specificRef]; TokenIO.WriteRope[tp.text]; CDIO.WriteLayer[me.layer]; CDIO.WritePos[me.size]; WriteFont[tp.cdFont]; END; Describe: PROC[me: CD.Object] RETURNS [Rope.ROPE] = BEGIN tp: TextPtr = NARROW[me.specificRef]; RETURN [Rope.Cat["text [", tp.text, "]"]] END; MakeKey1FromName: PROC [name: Rope.ROPE, scale: INT] RETURNS [Rope.ROPE] = BEGIN RETURN [IO.PutFR["!%0g*%0g", IO.rope[name], IO.int[scale]]]; END; <> <> <<>> <> <> <> <> <> <> <<>> <> <> <> FontFromKey1: PROC [key: Rope.ROPE] RETURNS [REF CDTexts.FontRec] = BEGIN WITH fontTab.Fetch[key].val SELECT FROM f: REF CDTexts.FontRec => RETURN [f]; ENDCASE => RETURN [NIL]; END; MakeFont: PUBLIC PROC [name: Rope.ROPE, scale: CD.Number] RETURNS [CDFont] = BEGIN RETURN [MyMakeFont1[name, scale, NIL]] END; MyMakeFont1: PROC [name: Rope.ROPE, scale: CD.Number, approx: ATOM _ NIL] RETURNS [REF CDTexts.FontRec] = BEGIN key: Rope.ROPE _ MakeKey1FromName[name, scale]; cdFont: REF CDTexts.FontRec _ FontFromKey1[key]; IF cdFont=NIL THEN cdFont _ CreateFont1[name, scale, approx]; RETURN [cdFont] END; IsIdentity: PROC [t: Imager.Transformation] RETURNS [BOOL] = BEGIN 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] END; Up: PROC [r: REAL] RETURNS [i: INT] = { <<-- returns integer i: i >= r; there exists no integer j such that j < i and j >= r >> i _ Real.Fix[r]; IF Real.Float[i]#r THEN i _ i+1; }; CDFontFromUnscaledImagerFont: PROC [font: Imager.Font, scale: INT, isPlaceHolder: BOOL_FALSE] RETURNS [cdFont: REF CDTexts.FontRec_NIL] = BEGIN IF font#NIL THEN { e: ImagerFont.Extents; scale _ MAX[1, scale]; IF ~IsIdentity[font.charToClient] THEN ERROR; cdFont _ NEW[CDTexts.FontRec_[properties: CD.InitPropRef[], origin: [0, 0], xy: [0, 0], format: 1]]; cdFont.scaleI _ scale; cdFont.scaleR _ scale; CDProperties.PutProp[cdFont.properties, $OriginalFont, font]; cdFont.font _ ImagerFont.Modify[font, ImagerTransformation.Scale[scale]]; e _ ImagerFont.FontBoundingBox[cdFont.font]; cdFont.xy.x _ Up[e.leftExtent]; cdFont.xy.y _ Up[e.descent]; cdFont.height _ Up[e.ascent]+Up[e.descent]; cdFont.origin.x _ Up[cdFont.xy.x]; cdFont.origin.y _ Up[cdFont.xy.y]; } END; CreateFont1: PUBLIC PROC [name: Rope.ROPE, scale: CD.Number, approx: ATOM _ NIL] RETURNS [cdFont: REF CDTexts.FontRec_NIL] = BEGIN key: Rope.ROPE _ MakeKey1FromName[name, scale]; font: Imager.Font; isPlaceHolder: BOOL _ FALSE; font _ FindExactFont[name]; IF font=NIL THEN { IF approx=NIL THEN RETURN [NIL]; IF approx=$compat THEN { font _ FindOldFont[name]; IF font#NIL THEN { name _ font.name; key _ MakeKey1FromName[name, scale] } }; IF font=NIL THEN { isPlaceHolder _ TRUE; font _ FindSomeFont[name]; }; }; IF font#NIL THEN { --exact font cdFont _ CDFontFromUnscaledImagerFont[font, scale, isPlaceHolder]; cdFont.format _ 1; cdFont.supposedKey _ key; cdFont.supposedName _ name; [] _ fontTab.Store[key, cdFont]; RETURN }; END; [] _ CDProperties.RegisterProperty[$OriginalFont, $CDTextsImpl]; END. <> <> <> <<.>>