
<<CDTextsImpl.mesa>>
<<by Christian Jacobi   July 29, 1983 11:17 am >>
<<last edited by Christian Jacobi   December 13, 1983 5:06 pm>>
<<>>
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 {
<<-- 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; 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] =
<<--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.