DIRECTORYCDTexts,CD,CDIO,CDOrient,CDValue,Rope USING [Cat, ROPE],Graphics,GraphicsOps,Real,TerminalIO,TokenIO,CDInline USING [Intersect];CDTextsImpl: CEDAR MONITOR IMPORTS  CD, CDInline, CDIO, CDOrient, CDValue, Graphics, GraphicsOps, Real, Rope, TerminalIO, TokenIOEXPORTS CDTexts  =  BEGINTextPtr: TYPE = CDTexts.TextPtr;TextRec: TYPE = CDTexts.TextRec;FontRec: TYPE = CDTexts.FontRec;defaultFont: REF FontRec; CreateText: PUBLIC PROC [text: Rope.ROPE, font: REF FontRec, level: CD.Level _ CD.combined] RETURNS [CD.ObPtr] =BEGIN w: REAL;tp: TextPtr ~ NEW[TextRec];tob: CD.ObPtr ~ NEW[CD.ObjectDefinition_[p: pForTexts, specificRef: tp]];IF font=NIL THEN font _ defaultFont;[xw: w] _ Graphics.RopeWidth[font.font, text];IF font.scaling THEN w _ w*font.scale;tob.size.y _ font.height; tob.size.x _ Real.FixC[w+2*font.baseOffsetX+0.999];IF level=CD.combined THEN tob.level _ font.levelSubstitute ELSE tob.level _ level;tp.text _ text;tp.font _ font;RETURN [tob]END;pForTexts: REF CD.ObjectProcs ~ CD.RegisterObjectType[$Text];Init: PROC [] =BEGINpForTexts.drawMe _ DrawMeForTexts;pForTexts.internalRead _ ReadText;pForTexts.internalWrite _ WriteText;pForTexts.describe _ Describe;defaultFont _ MakeFont[scale: 2];[] _ InstallFont[font: defaultFont, key: $CDxCompatibilityFont, technology: NIL];END; DrawMeForTexts: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,pr: CD.DrawRef] =BEGINDrawTextInContext: PROC [context: Graphics.Context] =BEGINtp: CDTexts.TextPtr _ NARROW[aptr.ob.specificRef];context.Translate[pos.x, pos.y];CDOrient.OrientateContext[context, aptr.ob.size, orient];context.ClipBox[[xmin: 0, ymin: 0, xmax: aptr.ob.size.x, ymax: aptr.ob.size.y]];context.SetColor[Graphics.black];IF tp.font.scaling THEN {s: REAL = tp.font.scale; context.Scale[s, s]};context.SetCP[tp.font.baseOffsetX, tp.font.baseOffsetY];context.DrawRope[rope: tp.text, font: tp.font.font];END;IF CDInline.Intersect[CDOrient.RectAt[pos, aptr.ob.size, orient], pr.worldClip] THENCD.DrawToContext[pr, DrawTextInContext, aptr.ob.level]END; MakeFont: PUBLIC PROC [name: Rope.ROPE_NIL, scale: REAL _ 1, height: CD.DesignNumber _ 0, whiteBorder: CD.DesignNumber _ -1, baseOffsetX: REAL _ -1, baseOffsetY: REAL _ -999, scaleByReplacingFontAllowed: BOOL _ FALSE, levelSubstitute: CD.Level _ CD.combined] RETURNS [REF FontRec] =BEGINmin, max: REAL;fontInfo: REF CDTexts.FontRec _ NEW[CDTexts.FontRec];IF scale<=0 THEN scale _ 1; fontInfo.scale _ scale;fontInfo.scaling _ scale#1.0;fontInfo.name _ name;IF name#NIL THEN fontInfo.font _ Graphics.MakeFont[name ! Graphics.Warning => IF type=fontNotFound THEN {fontInfo.font_NIL; CONTINUE}ELSE REJECT] ELSE fontInfo.font _ GraphicsOps.DefaultFont[];IF fontInfo.font=NIL THEN RETURN [NIL];[ymin: min, ymax: max] _ Graphics.FontBox[fontInfo.font];fontInfo.whiteBorder _ MAX[0, whiteBorder];fontInfo.baseOffsetX _ MAX[0.0, baseOffsetX];fontInfo.baseOffsetY _ MAX[-min, baseOffsetY];fontInfo.height _ MAX[Real.FixC[(max+fontInfo.baseOffsetY)*scale+0.99]+2*fontInfo.whiteBorder, height];fontInfo.levelSubstitute _ levelSubstitute;fontInfo.scaleByReplacingFontAllowed _ scaleByReplacingFontAllowed;RETURN [fontInfo]END;ReadFont: PROC [] RETURNS [font: REF CDTexts.FontRec] =BEGINname: Rope.ROPE = TokenIO.ReadRope[];scale: REAL = TokenIO.ReadInt[]/8.0;height: CD.DesignNumber = TokenIO.ReadInt[];whiteBorder: CD.DesignNumber = TokenIO.ReadInt[];levelSubstitute: CD.Level = CDIO.ReadLevel[];baseOffsetX: REAL = TokenIO.ReadInt[]/8.0;baseOffsetY: REAL = TokenIO.ReadInt[]/8.0;scaleByReplacingFontAllowed: BOOL = (1=TokenIO.ReadInt[]);font _ MakeFont[name: name, scale: scale, height: height, whiteBorder: whiteBorder, baseOffsetX: baseOffsetX, baseOffsetY: baseOffsetY, scaleByReplacingFontAllowed: scaleByReplacingFontAllowed, levelSubstitute: levelSubstitute];END;ReadText: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- =BEGINob: CD.ObPtr;x: INT _ -1;y: INT _ -1;r: Rope.ROPE;f: ATOM;lev: CD.Level _ CD.combined;font: REF FontRec;token: TokenIO.Token _ TokenIO.ReadToken[];IF token.kind=rope THEN {r _ NARROW[token.ref];}ELSE {x _ NARROW[token.ref, REF INT]^;y _ TokenIO.ReadInt[];lev _ CDIO.ReadLevel[];r _ TokenIO.ReadRope[]};f _ TokenIO.ReadAtom[];IF f#NIL THEN font _ GetFont[key: f, technology: CDIO.DesignInReadOperation[].technology]ELSE font _ ReadFont[];ob _ CreateText[text: r, font: font, level: lev];IF x>0 OR y>0 THENIF x#ob.size.x OR y#ob.size.y THENTerminalIO.WriteRope["**** size of text wrong; probablyuse of different font\n"];RETURN [ob]END;WriteFont: PROC [font: REF CDTexts.FontRec] =BEGINTokenIO.WriteRope[font.name];TokenIO.WriteInt[Real.RoundI[font.scale*8]];TokenIO.WriteInt[font.height];TokenIO.WriteInt[font.whiteBorder];CDIO.WriteLevel[font.levelSubstitute];TokenIO.WriteInt[Real.RoundI[font.baseOffsetX*8]];TokenIO.WriteInt[Real.RoundI[font.baseOffsetY*8]];TokenIO.WriteInt[(IF font.scaleByReplacingFontAllowed THEN 1 ELSE 0)];END;WriteText: CD.InternalWriteProc -- PROC [me: ObPtr] -- =BEGINtp: TextPtr = NARROW[me.specificRef];TokenIO.WriteInt[me.size.x];TokenIO.WriteInt[me.size.y];CDIO.WriteLevel[me.level];TokenIO.WriteRope[tp.text];TokenIO.WriteAtom[tp.font.key];IF tp.font.key=NIL THEN WriteFont[tp.font];END;InstallFont: PUBLIC ENTRY PROC [font: REF FontRec, key: ATOM_NIL, technology: CD.Technology] RETURNS [done: BOOL_FALSE] =BEGINIF key#NIL THEN font.key  _ key;IF technology#NIL THEN font.technology _ technology;CDValue.EnregisterKey[key: font.key, boundTo: font.technology ! CD.Error => GOTO notDone];CDValue.Store[boundTo: font.technology, key: font.key, value: font];done _ TRUE;EXITSnotDone => NULLEND;GetFont: PUBLIC PROC[key: ATOM, technology: CD.Technology _ NIL] RETURNS [REF FontRec] =BEGINfont: REF FontRec_NIL;x: REF = CDValue.Fetch[boundTo: technology, key: key, propagation: global];IF ISTYPE[x, REF FontRec] THEN font _ NARROW[x];RETURN [font]END;Describe: PROC[me: CD.ObPtr] RETURNS [Rope.ROPE] =BEGINtp: TextPtr = NARROW[me.specificRef];RETURN [Rope.Cat["text [", tp.text, "]"]]END;Init[];END.    8  CDTextsImpl.mesaby Christian Jacobi   July 29, 1983 11:17 am last edited by Christian Jacobi   December 13, 1983 5:06 pm-- old-- new--key and technology overwrite font^--done means GetFont would find the font--caller is supposed not to change font^ after Installation--returns NIL if not found Э╩Й  Ш JЪЬЩJЪЬ-Щ-JЪЬ;Щ;JЩ Ъ╧k	Ш	JШJЪЭЬШJШJШ	JШJЪЬЭЬЭЬШJШ	JШJШJЪЬШJЪЬШJЪЬ	ЭЬШJШ ЧЪ╧nЬЭЬЭЬШJЪЭЬЭЬ[ШfJЪЭЬШЧJЪЭШJШ JЪЬ	ЭЬШ JЪЬ	ЭЬШ JЪЬ	ЭЬШ JШ JЪЬЭЬ
ШJШ ЪЮ
ЬЭЬЭЬЭЬЭЬЭЬ	ЭЬЭЬЭЬ	ШpJЪЭЬШJЪЬЭЬШJЪЬЭЬ
ШЪЬЭЬ	ЭЬЭЬШ)JЪЬШJЪЬШJЪЬШЧJЪЭЬЭЬЭЬШ$JШ.JЪЭЬЭЬШ&JЪЬШJЪЬ3Ш3JЪЭЬЭЬ
ЭЬ"ЭЬШRJШJШJЪЭЬШJЪЭЬШJШ ЧJЪЬЭЬЭЬШ=JШ ЪЮЬЭЬШJЪЭШJШ"JЪЬ"Ш"JЪЬ$Ш$JЪЬШJШ!JЪЬLЭЬШQJЪЭЬШJШ ЧЪЮЬЭЬ ЭЬЭЬШ^JЪЬЭЬШJЪЭШJШ ЪЮЬЭЬШ5JЪЭШJЪЬЭЬШ2JЪЬ Ш JЪЬ9Ш9JЪЬPШPJЪЬ!Ш!JЪЭЬЭЬЭЬ'ШGJЪЬ8Ш8JЪЬ4Ш4JЪЭЬШЧJШ ЪЭЬNЭШTJЪЭЬ4Ш6ЧJЪЭЬШЧJШ ЪЮЬЭЬШJЪЬЭЬЭЬШJЪЬЭЬШJЪЬЭЬШJЪЬЭЬШ#JЪЬЭЬШJЪЬЭЬ	ШJЪЬЭЬЭЬШ+ЪЬЭЬ	ЭЬШ)JЪЭЬЭЬШЧJЪЭШJЪЬ
ЭЬШJЪЬ
ЭЬЭЬШ5JЪЭЬ
ЭЬШJЪЬШJЪЬШJЪЬШЪЭЬЭЬЭЬШЪЬ)Ш)ЪЬШJЪЭЬЭЬЭЬЭЬШ7JЪЭЬЭШЧJЪЬШЧЧJЪЭЬ+Ш/JЪ
ЭЬЭЬЭЬЭЬЭЬШ'JШ9JЪЬЭЬШ+JЪЬЭЬШ-JЪЬЭЬШ.JЪЬЭЬRШgJЪЬ+Ш+JЪЬCШCJЪЭЬШJЪЭЬШЧJШ ЪЮЬЭЬЭЬЭЬШ7JЪЭШJЪЬЭЬШ%JЪЬЭЬШ$JЪЬЭЬ"Ш,JЪЬЭЬ"Ш1JЪЬЭЬ	ЭЬШ-JЪЬЭЬШ*JЪЬЭЬШ*JЪЬЭЬШ:ЪЬШJЪЬШJЪЬ8Ш8JЪЬ4Ш4JЪЬ:Ш:JЪЬ Ш JЪЬШЧJЪЭЬШЧJШ Ъ╧bЬЭЬ╧cЬШ;JЪЭШJЪЬЭЬШJЪЬЭЬШJЪЬЭЬШJЪЬЭЬШJЪЬЭЬШJЪЬЭЬ	ЭЬ
ШJЪЬЭЬ	ШJШ+ЪЭЬЭЬШJЪЬЩJЪЬЭЬШJШЧЪЭЬШJЪЬЩJЪЬЭЬЭЬЭЬШ JШJЪЬЭЬШJЪЬШJЪЬШЧJЪЬШJЪЭЬЭЬЭЬ$ЭЬ$ШYJЪЭЬШJЪЬ1Ш1ЪЭЬЭЬЭШЪЭЬЭЬЭШ"JШQЧЧJЪЭЬШJЪЭЬШЧJШ ЪЮ	ЬЭЬЭЬШ-JЪЭШJЪЬШJЪЬ,Ш,JЪЬШJЪЬ#Ш#JЪЭЬ"Ш&JЪЬ2Ш2JЪЬ2Ш2JЪЬЭЬ"ЭЬЭЬШFJЪЭЬШЧJШ ЪЯ	ЬЭЬаЬШ8JЪЭШJЪЬЭЬШ%JЪЬШJЪЬШJЪЭЬШJЪЬШJЪЬШJЪЭЬЭЬЭЬШ+JЪЭЬШЧJШ ЪЮЬЭЬЭЬЭЬЭЬЭЬЭЬЭЬЭЬЭЬЭЬШyJЪЬ$Щ$JЪЬ(Щ(JЪЬ;Щ;JЪЭШJЪЭЬЭЬЭЬШ JЪЭЬЭЬЭЬШ4ЪЬ@Ш@JЪЭЬ
ЭЬШJЪЬШЧJЪЬDШDJЪЬЭЬШЪЭШJЪЬЭШЧJЪЭЬШJЩ ЧЪЮЬЭЬЭЬЭЬЭЬЭЬЭЬШXJЪЬЩJЪЭШJЪЬЭЬ	ЭЬШJЪЬЭЬEШKJЪ
ЭЬЭЬЭЬ
ЭЬЭЬШ0JЪЭЬШJЪЭЬШJЩ ЧЪ
ЮЬЭЬЭЬЭЬЭЬШ2JЪЭШJЪЬЭЬШ%JЪЭЬ#Ш)JЪЭЬШЧJШ JШJЪЭЬШJШ JШ Ч ЕЧ    D  "  