<> <> <> <> <<>> DIRECTORY CDTexts, CD, CDIO, CDValue, FS, Graphics, GraphicsOps, IO, Real, Rope, SymTab, TerminalIO, TokenIO; CDTextsImpl: CEDAR MONITOR IMPORTS CD, CDIO, CDValue, FS, Graphics, GraphicsOps, IO, Real, Rope, SymTab, 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, layer: CD.Layer _ 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.RoundI[w+2*font.baseOffsetX]; IF layer=CD.combined THEN tob.layer _ font.layerSubstitute ELSE tob.layer _ layer; tp.text _ text; tp.font _ font; RETURN [tob] END; pForTexts: REF CD.ObjectProcs ~ CD.RegisterObjectType[$Text]; fontTab: SymTab.Ref = SymTab.Create[mod: 7, case: FALSE]; Init: PROC [] = BEGIN pForTexts.drawMe _ pForTexts.quickDrawMe _ DrawMeForTexts; pForTexts.internalRead _ ReadText; pForTexts.internalWrite _ WriteText; pForTexts.describe _ Describe; pForTexts.origin _ Origin; defaultFont _ MakeFont[scale: CD.lambda]; [] _ InstallFont[font: defaultFont, key: $CDxCompatibilityFont, technology: NIL]; END; Origin: PROC [ob: CD.ObPtr] RETURNS [o: CD.DesignPosition] = BEGIN tp: CDTexts.TextPtr = NARROW[ob.specificRef]; o.x _ Real.RoundI[tp.font.scale*tp.font.baseOffsetX]; o.y _ Real.RoundI[tp.font.scale*tp.font.baseOffsetY]; END; DrawMeForTexts: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN DrawTextInContext: PROC [context: Graphics.Context, ob: CD.ObPtr, layer: CD.Layer] = BEGIN tp: CDTexts.TextPtr = NARROW[ob.specificRef]; context.ClipBox[[xmin: 0, ymin: 0, xmax: ob.size.x, ymax: ob.size.y]]; 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; pr.drawContext[pr, DrawTextInContext, aptr.ob, pos, orient, aptr.ob.layer] END; ReplaceBaseName: PROC [name: Rope.ROPE, newBase: Rope.ROPE] RETURNS [Rope.ROPE] = <<--does it, but i'm not so shure about working directories..>> BEGIN fName: Rope.ROPE; dirOmitted: BOOL; cr: FS.ComponentRopes; cp: FS.ComponentPositions; [fullFName: fName, cp: cp, dirOmitted: dirOmitted] _ FS.ExpandName[name: name, wDir: "///"]; cr.server _ fName.Substr[cp.server.start, cp.server.length]; cr.dir _ fName.Substr[cp.dir.start, cp.dir.length]; cr.subDirs _ fName.Substr[cp.subDirs.start, cp.subDirs.length]; cr.base _ newBase; cr.ext _ fName.Substr[cp.ext.start, cp.ext.length]; cr.ver _ fName.Substr[cp.ver.start, cp.ver.length]; RETURN [ FS.ConstructFName[cr, dirOmitted] ] END; NameBase: PROC [name: Rope.ROPE] RETURNS [Rope.ROPE] = BEGIN fName: Rope.ROPE; cp: FS.ComponentPositions; [fullFName: fName, cp: cp] _ FS.ExpandName[name: name]; RETURN [ Rope.Substr[fName, cp.base.start, cp.base.length] ] END; MakeGraphicsFont: PROC [name: Rope.ROPE] RETURNS [font: Graphics.FontRef] = BEGIN TryAlso: PROC [name: Rope.ROPE] RETURNS [next: Rope.ROPE_NIL] = <<--get rid of a B or I (for Bold or Italic)>> BEGIN base: Rope.ROPE _ NameBase[name]; <<--we don't handle ropes of length 0 and 1>> IF base.Length[]>1 THEN { ch: CHAR_ base.Fetch[base.Length[]-1]; IF ch='B OR ch='I OR ch='N THEN { next _ ReplaceBaseName[name: name, newBase: base.Substr[0, base.Length[]-1]] } } END; <<--MakeGraphicsFont>> ok: BOOL _ TRUE; original: Rope.ROPE _ name; DO font _ Graphics.MakeFont[name ! Graphics.Warning => {ok_FALSE; RESUME}]; IF ok THEN { IF original#name THEN TerminalIO.WriteRope[ Rope.Cat["Font ", original, " not found; use ", name, " instead\n"] ]; RETURN; }; name _ TryAlso[name]; IF name.IsEmpty[] THEN RETURN; ENDLOOP; END; MakeFont: PUBLIC PROC [ name: Rope.ROPE_NIL, scale: REAL _ 1, scaleByReplacingFontAllowed: BOOL _ FALSE, --ignored layerSubstitute: CD.Layer _ CD.combined] RETURNS [REF FontRec] = BEGIN fontInfo: REF CDTexts.FontRec_NIL; TheOldWay: PROC [] = BEGIN xmin, xmax, ymin, ymax: REAL; <<--reset to ignore>> scaleByReplacingFontAllowed _ FALSE; fontInfo _ 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 _ MakeGraphicsFont[name] ELSE fontInfo.font _ GraphicsOps.DefaultFont[]; IF fontInfo.font=NIL THEN fontInfo _ NIL ELSE { [xmin: xmin, ymin: ymin, xmax: xmax, ymax: ymax] _ Graphics.FontBox[fontInfo.font]; fontInfo.whiteBorder _ 0; fontInfo.baseOffsetX _ -xmin; fontInfo.baseOffsetY _ -ymin; fontInfo.height _ Real.RoundI[(ymax-ymin)*scale]; fontInfo.layerSubstitute _ layerSubstitute; fontInfo.scaleByReplacingFontAllowed _ scaleByReplacingFontAllowed; }; END; hash: Rope.ROPE = IO.PutFR["%01g%01g%01g", IO.rope[name], IO.real[scale], IO.int[layerSubstitute]]; WITH fontTab.Fetch[hash].val SELECT FROM f: REF CDTexts.FontRec => fontInfo _ f; ENDCASE => { TheOldWay[]; [] _ fontTab.Store[hash, fontInfo] }; 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[]; layerSubstitute: CD.Layer = CDIO.ReadLayer[]; baseOffsetX: REAL = TokenIO.ReadInt[]/8.0; baseOffsetY: REAL = TokenIO.ReadInt[]/8.0; scaleByReplacingFontAllowed: BOOL = (1=TokenIO.ReadInt[]); font _ MakeFont[ name: name, scale: scale, scaleByReplacingFontAllowed: scaleByReplacingFontAllowed, layerSubstitute: layerSubstitute ]; END; ReadText: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- = BEGIN ob: CD.ObPtr; x: INT _ -1; y: INT _ -1; r: Rope.ROPE; f: ATOM; lev: CD.Layer _ CD.combined; font: REF FontRec; token: TokenIO.Token _ TokenIO.ReadToken[]; IF token.kind=rope THEN { <<-- old>> r _ NARROW[token.ref]; } ELSE { <<-- new>> x _ NARROW[token.ref, REF INT]^; y _ TokenIO.ReadInt[]; lev _ CDIO.ReadLayer[]; 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, layer: 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; probably use 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.WriteLayer[font.layerSubstitute]; 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.WriteLayer[me.layer]; 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] = <<--make a copy, such that overwrite does not harm>> <<--key and technology overwrite font^>> <<--done means GetFont would find the font>> <<--caller is supposed not to change font^ after Installation>> BEGIN ENABLE UNWIND => NULL; fontCopy: REF CDTexts.FontRec = NEW[CDTexts.FontRec_font^]; IF key#NIL THEN fontCopy.key _ key; IF technology#NIL THEN fontCopy.technology _ technology; CDValue.EnregisterKey[key: fontCopy.key, boundTo: fontCopy.technology ! CD.Error => GOTO notDone ]; CDValue.Store[boundTo: fontCopy.technology, key: fontCopy.key, value: fontCopy]; done _ TRUE; EXITS notDone => NULL END; <<>> GetFont: PUBLIC PROC[key: ATOM, technology: CD.Technology _ NIL] RETURNS [REF FontRec] = <<--returns NIL if not found>> 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.