CDTextsImpl.mesa
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, July 29, 1983 11:17 am
last edited by Christian Jacobi, April 11, 1985 9:23:08 am PST
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𡤏ont^];
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;
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.