CDTextsImpl.mesa
Copyright © 1983 by Xerox Corporation. All rights reserved.
by Christian Jacobi July 29, 1983 11:17 am
last edited by Christian Jacobi November 5, 1984 10:25:32 am PST
DIRECTORY
CDTexts,
CD,
CDBasics USING [Intersect],
CDIO,
CDOrient,
CDValue,
Rope USING [Cat, ROPE],
Graphics,
GraphicsOps,
Real,
TerminalIO,
TokenIO;
CDTextsImpl: CEDAR MONITOR
IMPORTS CD, CDBasics, 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.RoundC[w+2*font.baseOffsetX];
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 CDBasics.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.RoundC[(max+fontInfo.baseOffsetY)*scale]+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 {
-- old
r ← NARROW[token.ref];
}
ELSE {
-- new
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; 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.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] =
--key and technology overwrite font^
--done means GetFont would find the font
--caller is supposed not to change font^ after Installation
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] =
--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.