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, August 30, 1985 5:39:01 pm PDT
DIRECTORY
Atom,
CDTexts,
CD,
CDIO,
FS,
Imager,
ImagerFont,
ImagerTransformation,
IO,
Real,
Rope,
RuntimeError USING [UNCAUGHT],
SymTab,
TerminalIO,
TokenIO,
VFonts;
CDTextsImpl:
CEDAR
MONITOR
IMPORTS Atom, CD, CDIO, FS, Imager, ImagerFont, ImagerTransformation, IO, Real, Rope, RuntimeError, SymTab, TerminalIO, TokenIO, VFonts
EXPORTS CDTexts =
BEGIN
TextPtr: TYPE = CDTexts.TextPtr;
TextRec: TYPE = CDTexts.TextRec;
FontRec: TYPE = CDTexts.FontRec;
CDFont: TYPE = CDTexts.CDFont;
textClass: REF CD.ObjectClass = CD.RegisterObjectClass[$Text];
fontTab: SymTab.Ref ← SymTab.Create[mod: 31, case: FALSE];
CreateText:
PUBLIC
PROC [text: Rope.
ROPE, font:
REF
READONLY
ANY, layer:
CD.Layer ←
CD.combined]
RETURNS [
CD.Object] =
BEGIN
WITH font
SELECT
FROM
cdFont: CDFont => {
e: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[cdFont.font, text];
w: REAL ← ImagerFont.RopeWidth[cdFont.font, text].x;
tp: TextPtr ← NEW[TextRec ← [text: text, cdFont: cdFont]];
tob:
CD.Object ←
NEW[
CD.ObjectRep←[
size: [cdFont.origin.x+Up[e.rightExtent], cdFont.height],
class: textClass,
specificRef: tp,
layer: layer
]];
RETURN [tob]
};
font: Imager.Font => {
cdFont: CDFont ← MakeFont[font];
RETURN [CreateText[text, cdFont, layer]];
};
ENDCASE => RETURN [NIL]
END;
Init:
PROC [] =
BEGIN
textClass.drawMe ← textClass.quickDrawMe ← DrawMeForTexts;
textClass.internalRead ← ReadText;
textClass.internalWrite ← WriteText;
textClass.describe ← Describe;
textClass.origin ← Origin;
END;
Origin:
PROC [ob:
CD.Object]
RETURNS [o:
CD.Position] =
BEGIN
o ← NARROW[ob.specificRef, TextPtr].cdFont.origin;
END;
DrawMeForTexts:
PROC [inst: CD.Instance, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
DrawTextInContext:
PROC [context: Imager.Context, ob:
CD.Object, layer:
CD.Layer] =
BEGIN
tp: CDTexts.TextPtr = NARROW[ob.specificRef];
--don't clip; speeeed;
--Imager.ClipRectangle[context, [x: 0, y: 0, w: ob.size.x, h: ob.size.y]];
IF pr.b2 THEN Imager.SetFont[context, tp.cdFont.font] --normal case
ELSE {
--use substituted font
font: CDTexts.CDFont;
WITH Atom.GetPropFromList[pr.properties, $FontExchange]
SELECT
FROM
xp:
REF
PROC [CDTexts.CDFont]
RETURNS [CDTexts.CDFont] =>
font ← xp^[tp.cdFont];
ENDCASE => font ← tp.cdFont;
Imager.SetFont[context, font.font];
};
Imager.SetXY[context, tp.cdFont.xy]; --always use original font offsets!
Imager.ShowRope[context, tp.text];
END;
pr.drawContext[pr, DrawTextInContext, inst.ob, pos, orient, inst.ob.layer]
END;
catchOnFontProblem: BOOL ← TRUE;
FindExactFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] =
BEGIN
font ← ImagerFont.Find[name !
Imager.Error => {
font ← NIL;
TerminalIO.WriteRope[Rope.Cat["**error while loading font: ", error.explanation, "\n"]];
IF catchOnFontProblem THEN CONTINUE;
};
RuntimeError.
UNCAUGHT => {
font ← NIL;
TerminalIO.WriteRope[Rope.Cat["**unknown error while loading font ", name, "\n"]];
IF catchOnFontProblem THEN CONTINUE;
}
];
END;
FindOldFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] =
BEGIN
BasePart:
PROC [name: Rope.
ROPE]
RETURNS [Rope.
ROPE] = {
fName: Rope.ROPE;
cp: FS.ComponentPositions;
[fullFName: fName, cp: cp] ← FS.ExpandName[name: name];
RETURN [ Rope.Substr[fName, cp.base.start, cp.base.length] ]
};
FindFontOrXFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] = {
font ← FindExactFont[name];
IF font=NIL THEN font ← FindExactFont[Rope.Concat["Xerox/TiogaFonts/", name]];
};
TryAlso:
PROC [name: Rope.
ROPE]
RETURNS [next: Rope.
ROPE←
NIL] =
--get rid of a B or I (for Bold or Italic)
BEGIN
--we don't handle ropes of length 0 and 1
IF name.Length[]>1
THEN {
ch: CHAR ← name.Fetch[name.Length[]-1];
IF ch='B
OR ch='I
OR ch='N
THEN {
next ← name.Substr[0, name.Length[]-1]
}
}
END;
--FindOldFont
ok: BOOL ← TRUE;
copy: Rope.ROPE ← BasePart[name];
name ← copy;
DO
font ← FindFontOrXFont[copy];
IF font#
NIL
THEN {
IF copy#name
THEN TerminalIO.WriteRope[
Rope.Cat["Font ", name, " not found; use ", copy, " instead\n"]
];
RETURN;
};
copy ← TryAlso[copy];
IF copy.IsEmpty[] THEN RETURN;
ENDLOOP;
END;
FindSomeFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] =
BEGIN
TerminalIO.WriteRope[Rope.Cat["**font ", name, " substituted\n"]];
RETURN [VFonts.defaultFont];
END;
OldReadText:
CD.InternalReadProc
--PROC [] RETURNS [Object]-- =
BEGIN
OldReadFont:
PROC []
RETURNS [font:
REF CDTexts.FontRec] =
--for version<=8
BEGIN
name: Rope.ROPE = TokenIO.ReadRope[];
scale: INT = MAX[TokenIO.ReadInt[]/8, 1]; --originally used a real
ignoreHeight: CD.Number = TokenIO.ReadInt[];
ignoreWhiteBorder: CD.Number = TokenIO.ReadInt[];
ignoreLayerSubstitute: CD.Layer = CDIO.ReadLayer[];
ignoreBaseOffsetX: REAL = TokenIO.ReadInt[]/8.0;
ignoreBaseOffsetY: REAL = TokenIO.ReadInt[]/8.0;
ignoreScaleByReplacingFontAllowed: BOOL = (1=TokenIO.ReadInt[]);
font ← MyMakeFont1[name: name, scale: scale, approx: $compat];
END;
ob: CD.Object;
x: INT ← -1;
y: INT ← -1;
r: Rope.ROPE;
f: ATOM;
lay: CD.Layer ← CD.combined;
font: REF FontRec;
token: TokenIO.Token ← TokenIO.ReadToken[];
IF token.kind=rope
THEN {
-- very old
r ← NARROW[token.ref];
}
ELSE {
-- less old
x ← NARROW[token.ref, REF INT]^;
y ← TokenIO.ReadInt[];
lay ← CDIO.ReadLayer[];
r ← TokenIO.ReadRope[]
};
f ← TokenIO.ReadAtom[];
IF f#NIL THEN ERROR;
font ← OldReadFont[];
ob ← CreateText[text: r, font: font, layer: lay];
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;
changeTextSizeIfDifferent: BOOL ← FALSE;
msg: BOOL ← FALSE;
ReadText:
CD.InternalReadProc =
BEGIN
ob: CD.Object;
x, y: INT;
r: Rope.ROPE;
cdFont: REF CDTexts.FontRec;
lay: CD.Layer;
IF CDIO.VersionKey[]<=8 THEN RETURN [OldReadText[]];
r ← TokenIO.ReadRope[];
lay ← CDIO.ReadLayer[];
x ← TokenIO.ReadInt[];
y ← TokenIO.ReadInt[];
cdFont ← ReadFont[];
ob ← CreateText[text: r, font: cdFont, layer: lay];
IF x#ob.size.x
OR y#ob.size.y
THEN {
TerminalIO.WriteRope["** size of text wrong; probably use of different font\n"];
IF ~msg
THEN {
TerminalIO.WriteRope["** to change object sizes to the current font requirements type "" ← CDTextsImpl.changeTextSizeIfDifferent ← TRUE"" into an interpreter and read in the file again. Then set it again to FALSE\n"];
msg←TRUE;
};
IF ~changeTextSizeIfDifferent THEN ob.size ← [x, y];
};
RETURN [ob]
END;
ReadFont:
PROC []
RETURNS [cdFont:
REF CDTexts.FontRec] =
BEGIN
format: INT ← TokenIO.ReadInt[];
SELECT format
FROM
1 => {
name: Rope.ROPE;
scale: INT;
name ← TokenIO.ReadRope[];
scale ← TokenIO.ReadInt[];
cdFont ← MyMakeFont1[name, scale, $IO];
};
ENDCASE => ERROR
END;
WriteFont:
PROC [cdFont: CDFont] =
BEGIN
TokenIO.WriteInt[cdFont.format];
IF cdFont.format=1
THEN {
TokenIO.WriteRope[cdFont.supposedName];
TokenIO.WriteInt[cdFont.scaleI];
}
ELSE ERROR;
END;
WriteText:
CD.InternalWriteProc
-- PROC [me: Object] -- =
BEGIN
tp: TextPtr = NARROW[me.specificRef];
TokenIO.WriteRope[tp.text];
CDIO.WriteLayer[me.layer];
TokenIO.WriteInt[me.size.x];
TokenIO.WriteInt[me.size.y];
WriteFont[tp.cdFont];
END;
Describe:
PROC[me:
CD.Object]
RETURNS [Rope.
ROPE] =
BEGIN
tp: TextPtr = NARROW[me.specificRef];
RETURN [Rope.Cat["text [", tp.text, "]"]]
END;
MakeKey1FromName:
PROC [name: Rope.
ROPE, scale:
CD.Number ←
CD.lambda]
RETURNS [Rope.
ROPE] =
BEGIN
RETURN [IO.PutFR["!%0g*%0g", IO.rope[name], IO.int[scale]]];
END;
MakeKeyFromFont: PROC [font: Imager.Font, scale: CD.Number ← CD.lambda] RETURNS [Rope.ROPE] =
BEGIN
HashT: PROC [t: Imager.Transformation] RETURNS [Rope.ROPE] =
BEGIN
r: Rope.ROPE;
IF IsIdentity[t] THEN RETURN ["="];
r ← IO.PutFR["%g,%g,%g,%g", IO.real[t.a], IO.real[t.b], IO.real[t.c], IO.real[t.d]];
RETURN [IO.PutFR["%g,%g,%g", IO.rope[r], IO.real[t.e], IO.real[t.f]]]
END;
trans: Rope.ROPE ← HashT[font.charToClient];
RETURN [IO.PutFR["%0gT%0gS%0g", IO.rope[font.name], IO.rope[trans], IO.int[scale]]];
END;
FontFromKey1:
PROC [key: Rope.
ROPE]
RETURNS [
REF CDTexts.FontRec] =
BEGIN
WITH fontTab.Fetch[key].val
SELECT
FROM
f: REF CDTexts.FontRec => RETURN [f];
ENDCASE => RETURN [NIL];
END;
MakeFont1:
PUBLIC
PROC [name: Rope.
ROPE, scale:
CD.Number ←
CD.lambda]
RETURNS [CDFont] =
BEGIN
RETURN [MyMakeFont1[name, scale, NIL]]
END;
MyMakeFont1:
PROC [name: Rope.
ROPE, scale:
CD.Number ←
CD.lambda, approx:
ATOM ←
NIL]
RETURNS [
REF CDTexts.FontRec] =
BEGIN
key: Rope.ROPE ← MakeKey1FromName[name, scale];
cdFont: REF CDTexts.FontRec ← FontFromKey1[key];
IF cdFont=NIL THEN cdFont ← CreateFont1[name, scale, approx];
RETURN [cdFont]
END;
MakeFontR:
PUBLIC
PROC [name: Rope.
ROPE, scale:
REAL]
RETURNS [
REF CDTexts.FontRec] =
BEGIN
--not yet implemented
RETURN [NIL]
END;
IsIdentity:
PROC [t: Imager.Transformation]
RETURNS [
BOOL] =
BEGIN
RETURN [t.a=1.0 AND t.b=0.0 AND t.c=0.0 AND t.d=0.0 AND t.e=1.0 AND t.f=0.0]
END;
Up:
PROC [r:
REAL]
RETURNS [i:
INT] = {
-- returns integer i: i >= r; there exists no integer j such that j < i and j >= r
i ← Real.Fix[r];
IF Real.Float[i]#r THEN i ← i+1;
};
CDFontFromUnscaledImagerFont:
PROC [font: Imager.Font, scale:
INT, isPlaceHolder:
BOOL←
FALSE]
RETURNS [cdFont:
REF CDTexts.FontRec←
NIL] =
BEGIN
IF font#
NIL
THEN {
e: ImagerFont.Extents;
scale ← MAX[1, scale];
IF ~IsIdentity[font.charToClient] THEN ERROR;
cdFont ← NEW[CDTexts.FontRec];
cdFont.scaleI ← scale;
cdFont.scaleR ← scale;
cdFont.font ← ImagerFont.Modify[font, ImagerTransformation.Scale[scale]];
e ← ImagerFont.FontBoundingBox[cdFont.font];
cdFont.xy.x ← Up[e.leftExtent];
cdFont.xy.y ← Up[e.descent];
cdFont.height ← Up[e.ascent]+Up[e.descent];
cdFont.origin.x ← Up[cdFont.xy.x];
cdFont.origin.y ← Up[cdFont.xy.y];
}
END;
CreateFont1:
PUBLIC
PROC [name: Rope.
ROPE, scale:
CD.Number, approx:
ATOM ←
NIL]
RETURNS [cdFont:
REF CDTexts.FontRec←
NIL] =
BEGIN
key: Rope.ROPE ← MakeKey1FromName[name, scale];
font: Imager.Font;
isPlaceHolder: BOOL ← FALSE;
font ← FindExactFont[name];
IF font=
NIL
THEN {
IF approx=NIL THEN RETURN [NIL];
IF approx=$compat
THEN {
font ← FindOldFont[name];
IF font#
NIL
THEN {
name ← font.name;
key ← MakeKey1FromName[name, scale]
}
};
IF font=
NIL
THEN {
isPlaceHolder ← TRUE;
font ← FindSomeFont[name];
};
};
IF font#
NIL
THEN {
--exact font
cdFont ← CDFontFromUnscaledImagerFont[font, scale, isPlaceHolder];
cdFont.format ← 1;
cdFont.supposedKey ← key;
cdFont.supposedName ← name;
[] ← fontTab.Store[key, cdFont];
RETURN
};
END;
Init[];
END.