CDTextsImpl.mesa
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, July 29, 1983 11:17 am
gbb April 4, 1986 3:47:34 pm PST
Last Edited by: Christian Jacobi, August 21, 1986 3:44:45 pm PDT
DIRECTORY
CDTexts,
CDTextsExtras,
CDEvents,
CDPrivate,
CDProperties,
CD,
CDIO,
CDOrient,
FS,
Imager,
ImagerFont,
ImagerTransformation,
IO,
LRUCache,
Real,
Rope,
RuntimeError USING [UNCAUGHT],
SymTab,
TerminalIO,
TokenIO,
VFonts;
CDTextsImpl:
CEDAR
MONITOR
IMPORTS CD, CDIO, CDEvents, CDPrivate, CDProperties, FS, Imager, ImagerFont, ImagerTransformation, IO, LRUCache, Real, Rope, RuntimeError, SymTab, TerminalIO, TokenIO, VFonts
EXPORTS CDTexts, CDTextsExtras =
BEGIN
TextPtr: TYPE = CDTexts.TextPtr;
TextRec: TYPE = CDTexts.TextRec;
FontRec: TYPE = CDTexts.FontRec;
CDFont: TYPE = CDTexts.CDFont;
convertClass:
PUBLIC
CD.ObjectClass ←
CD.RegisterObjectClass[$Text, [
internalRead: ConvertRead
]];
rigidTextClass:
PUBLIC
CD.ObjectClass ←
CD.RegisterObjectClass[$RigidText, [
drawMe: FixDraw,
quickDrawMe: FixDraw,
internalRead: Read,
internalWrite: Write,
describe: Describe,
origin: Origin
]];
flipTextClass:
PUBLIC
CD.ObjectClass ←
CD.RegisterObjectClass[$FlipText, [
drawMe: FlipDraw,
quickDrawMe: FlipDraw,
internalRead: Read,
internalWrite: Write,
describe: Describe,
origin: Origin
]];
textClass: PUBLIC CD.ObjectClass ← flipTextClass;
lruQueue: LRUCache.Handle ← LRUCache.Create[127, CDPrivate.Hash, Equal];
free: CD.Object ← NIL;
GiveOb:
ENTRY
PROC []
RETURNS [ob:
CD.Object] = {
ob ← free; free ← NIL;
IF ob=
NIL
THEN
ob ← NEW[CD.ObjectRep←[specificRef: NEW[TextRec]]];
};
Equal:
PROC[x, y:
REF]
RETURNS [
BOOL] = {
EqualSpec:
PROC[x, y:
CD.Object]
RETURNS [
BOOL] = {
tp1: TextPtr = NARROW[x.specificRef];
tp2: TextPtr = NARROW[y.specificRef];
RETURN [
Rope.Equal[tp1.text, tp2.text, TRUE] AND
Rope.Equal[tp1.cdFont.supposedKey, tp2.cdFont.supposedKey, TRUE]
]
};
ob1: CD.Object = NARROW[x];
ob2: CD.Object = NARROW[y];
RETURN [ob1.class=ob2.class AND ob1.size=ob2.size AND ob1.layer=ob2.layer AND EqualSpec[ob1, ob2]]
};
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;
};
Create:
PUBLIC
PROC [text: Rope.
ROPE, font:
REF
READONLY
ANY, layer:
CD.Layer, flip:
BOOL←
TRUE]
RETURNS [ob:
CD.Object] = {
ENABLE UNWIND => NULL;
WITH font
SELECT
FROM
cdFont: CDFont => {
insert: BOOL; used: REF;
e: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[cdFont.font, text];
w: REAL ← ImagerFont.RopeWidth[cdFont.font, text].x;
ob ← GiveOb[];
NARROW[ob.specificRef, TextPtr]^ ← [text: text, cdFont: cdFont];
ob.size ← [cdFont.origin.x+Up[e.rightExtent], cdFont.height];
ob.class ← IF flip THEN flipTextClass ELSE rigidTextClass;
ob.layer ← layer;
[insert: insert, used: used] ← LRUCache.Include[lruQueue, ob];
IF ~insert
THEN {
free ← ob;
ob ← NARROW[used];
};
};
ENDCASE => NULL
};
FixDraw:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] = {
DrawInContext:
PROC [context: Imager.Context, ob:
CD.Object, layer:
CD.Layer] = {
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.specialFonts
THEN {
--use substituted font
font: CDTexts.CDFont;
WITH CDProperties.GetListProp[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];
}
ELSE Imager.SetFont[context, tp.cdFont.font]; --normal case
Imager.SetXY[context, tp.cdFont.xy]; --always use original font offsets!
Imager.ShowRope[context, tp.text];
};
pr.drawContext[pr, DrawInContext, inst.ob, pos, orient, inst.ob.layer]
};
FlipDraw:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] = {
DrawInContext:
PROC [context: Imager.Context, ob:
CD.Object, layer:
CD.Layer] = {
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.specialFonts
THEN {
--use substituted font
font: CDTexts.CDFont;
WITH CDProperties.GetListProp[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];
}
ELSE Imager.SetFont[context, tp.cdFont.font]; --normal case
SELECT orient
FROM
CDOrient.original, CDOrient.rotate270 => NULL;
CDOrient.mirrorX, CDOrient.rotate90X => {
Imager.Scale2T[context, [-1, 1]]; Imager.TranslateT[context, [-ob.size.x, 0]];
};
CDOrient.rotate180X, CDOrient.rotate270X => {
Imager.Scale2T[context, [-1, 1]]; Imager.TranslateT[context, [-ob.size.x, 0]];
Imager.RotateT[context, 180]; Imager.TranslateT[context, [-ob.size.x, -ob.size.y]];
};
CDOrient.rotate180, CDOrient.rotate90 => {
Imager.RotateT[context, 180]; Imager.TranslateT[context, [-ob.size.x, -ob.size.y]];
};
ENDCASE => NULL;
Imager.SetXY[context, tp.cdFont.xy]; --always use original font offsets!
Imager.ShowRope[context, tp.text];
};
pr.drawContext[pr, DrawInContext, inst.ob, pos, orient, inst.ob.layer]
};
Origin:
PROC [ob:
CD.Object]
RETURNS [o:
CD.Position] = {
o ← NARROW[ob.specificRef, TextPtr].cdFont.origin;
};
Describe:
PROC[me:
CD.Object]
RETURNS [r: Rope.
ROPE] = {
tp: TextPtr = NARROW[me.specificRef];
r ← Rope.Cat["text [", tp.text, "]"];
IF me.class#flipTextClass THEN r ← Rope.Concat["X-", r];
};
Write:
CD.InternalWriteProc = {
tp: TextPtr = NARROW[me.specificRef];
CDIO.WritePos[me.size];
TokenIO.WriteRope[tp.text];
WriteFont[tp.cdFont];
CDIO.WriteLayer[me.layer];
IF me.class=flipTextClass THEN TokenIO.WriteInt[1] ELSE TokenIO.WriteInt[0]
};
Read:
CD.InternalReadProc = {
ob: CD.Object; sz: CD.Position; r: Rope.ROPE; i: INT;
cdFont: REF CDTexts.FontRec; layer: CD.Layer;
sz ← CDIO.ReadPos[];
r ← TokenIO.ReadRope[];
cdFont ← ReadFont[];
layer ← CDIO.ReadLayer[];
i ← TokenIO.ReadInt[];
ob ← Create[text: r, font: cdFont, layer: layer, flip: i=1];
IF sz#ob.size THEN FixSize[ob, sz];
RETURN [ob]
};
changeTextSizeIfDifferent: BOOL ← FALSE;
changeMsg: BOOL ← FALSE;
FixSize:
PROC [ob:
CD.Object, sz:
CD.Position] = {
IF sz#ob.size
THEN {
TerminalIO.WriteRope["** size of text wrong; probably use of different font\n"];
IF ~changeMsg
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"];
changeMsg ← TRUE;
};
IF ~changeTextSizeIfDifferent THEN ob.size ← sz;
};
};
ReadFont:
PROC []
RETURNS [cdFont:
REF CDTexts.FontRec] = {
format: INT ← TokenIO.ReadInt[];
SELECT format
FROM
1 => {
name: Rope.ROPE;
scale: INT;
name ← TokenIO.ReadRope[];
scale ← TokenIO.ReadInt[];
cdFont ← InternalMakeFont[name, scale, $IO];
};
ENDCASE => ERROR
};
WriteFont:
PROC [cdFont: CDFont] = {
TokenIO.WriteInt[cdFont.format];
IF cdFont.format#1 THEN ERROR
ELSE {
TokenIO.WriteRope[cdFont.supposedName];
TokenIO.WriteInt[cdFont.scaleI];
};
};
-- Fonts ========================================
fontCache: SymTab.Ref ← SymTab.Create[mod: 31, case: FALSE];
MakeKey:
PROC [name: Rope.
ROPE, scale:
INT]
RETURNS [Rope.
ROPE] = {
RETURN [IO.PutFR["!%0g*%0g", IO.rope[name], IO.int[scale]]];
};
GetCachedFont:
PROC [name: Rope.
ROPE, scale:
CD.Number]
RETURNS [
REF CDTexts.FontRec] = {
WITH fontCache.Fetch[MakeKey[name, scale]].val
SELECT
FROM
f: REF CDTexts.FontRec => RETURN [f];
ENDCASE => RETURN [NIL];
};
CreateFont:
PROC [name: Rope.
ROPE, scale:
CD.Number, approx:
ATOM ←
NIL]
RETURNS [cdFont:
REF CDTexts.FontRec←
NIL] = {
FindFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] = {
font ← ImagerFont.Find[name !
Imager.Error => {
font ← NIL;
TerminalIO.WriteRopes["**error while loading font ", name, ": "];
TerminalIO.WriteRopes[error.explanation, "\n"];
CONTINUE;
};
RuntimeError.
UNCAUGHT => {
font ← NIL;
TerminalIO.WriteRopes["**unknown error while loading font ", name, "\n"];
CONTINUE;
}
];
};
IsIdentity:
PROC [t: Imager.Transformation]
RETURNS [
BOOL] = {
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]
};
Internalize:
PROC [font: Imager.Font, scale:
INT]
RETURNS [cdf:
REF CDTexts.FontRec←
NIL] = {
IF font#
NIL
THEN {
e: ImagerFont.Extents;
scale ← MAX[1, scale];
IF ~IsIdentity[font.charToClient] THEN ERROR;
cdf ← NEW[CDTexts.FontRec ← [properties: CD.InitPropRef[], origin: [0, 0], xy: [0, 0], format: 1]];
cdf.scaleI ← scale;
cdf.scaleR ← scale;
CDProperties.PutProp[cdf.properties, $OriginalFont, font];
cdf.font ← ImagerFont.Modify[font, ImagerTransformation.Scale[scale]];
e ← ImagerFont.FontBoundingBox[cdf.font];
cdf.xy.x ← Up[e.leftExtent];
cdf.xy.y ← Up[e.descent];
cdf.height ← Up[e.ascent]+Up[e.descent];
cdf.origin.x ← Up[cdf.xy.x];
cdf.origin.y ← Up[cdf.xy.y];
}
};
FindPlaceholderFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] = {
TerminalIO.WriteRopes["**font ", name, " substituted\n"];
RETURN [VFonts.defaultFont];
};
isPlaceHolder: BOOL ← FALSE;
font: Imager.Font ← FindFont[name];
IF font=
NIL
THEN {
SELECT approx
FROM
NIL => RETURN [NIL];
$old => {
font ← OldFindFont[name];
IF font#NIL THEN name ← font.name; --to prevent bad cache entries!!
};
$IO => NULL;
ENDCASE => TerminalIO.WriteRope["** bad font mode key\n"];
IF font=
NIL
THEN {
isPlaceHolder ← TRUE;
font ← FindPlaceholderFont[name];
};
};
IF font#
NIL
THEN {
--exact font
cdFont ← Internalize[font, scale];
cdFont.isPlaceHolder ← isPlaceHolder;
cdFont.supposedKey ← MakeKey[name, scale];
cdFont.supposedName ← name;
[] ← fontCache.Store[cdFont.supposedKey, cdFont];
RETURN
};
};
InternalMakeFont:
PROC [name: Rope.
ROPE, scale:
CD.Number, approx:
ATOM]
RETURNS [cdFont:
REF FontRec] = {
cdFont ← GetCachedFont[name, scale];
IF cdFont=NIL THEN cdFont ← CreateFont[name, scale, approx];
};
MakeFont:
PUBLIC
PROC [name: Rope.
ROPE, scale:
CD.Number]
RETURNS [CDFont] = {
RETURN [InternalMakeFont[name, scale, NIL]]
};
-- Old ========================================
CreateText:
PUBLIC
PROC [text: Rope.
ROPE, font:
REF
READONLY
ANY, layer:
CD.Layer]
RETURNS [ob:
CD.Object←
NIL] = {
ob ← ConvertCreateText[text, font, layer, NIL];
};
ConvertCreateText:
PROC [text: Rope.
ROPE, font:
REF
READONLY
ANY, layer:
CD.Layer, key:
ATOM]
RETURNS [ob:
CD.Object←
NIL] = {
WITH font
SELECT
FROM
cdFont: CDFont => {
flip: BOOL ← layer=CD.commentLayer;
IF Rope.Match["*symbol*", cdFont.supposedName, FALSE] THEN flip ← FALSE;
IF Rope.Match["*gate*", cdFont.supposedName, FALSE] THEN flip ← FALSE;
IF key=$chipnsil OR key=$never THEN flip ← FALSE;
ob ← Create[text, cdFont, layer, flip]
};
ENDCASE => NULL
};
neverFlip: BOOL ← FALSE;
flipMsg: BOOL ← FALSE;
ReadEvent: CDEvents.EventProc = {
changeMsg ← flipMsg ← FALSE;
ConvertRead:
CD.InternalReadProc = {
ob: CD.Object; sz: CD.Position; r: Rope.ROPE;
cdFont: REF CDTexts.FontRec; layer: CD.Layer;
IF CDIO.VersionKey[]<=8 THEN RETURN [VeryOldReadText[]];
r ← TokenIO.ReadRope[];
layer ← CDIO.ReadLayer[];
IF layer=
CD.undefLayer
AND
CDIO.VersionKey[]<=14
THEN {
layer ← CD.commentLayer;
TerminalIO.WriteRope["** layer of text converted to comment\n"];
};
sz ← CDIO.ReadPos[];
cdFont ← ReadFont[];
ob ← ConvertCreateText[text: r, font: cdFont, layer: layer,
key: IF neverFlip THEN $never ELSE CDIO.DesignInReadOperation[].technology.key
];
IF ~flipMsg
THEN {
flipMsg ← TRUE;
TerminalIO.WriteRope["**did convert text to either rigid or flip text; you can guide the conversion with either\n ← CDTextsImpl.neverFlip ← TRUE\n ← CDTextsImpl.neverFlip ← FALSE\nand repeating the input\n"];
};
IF sz#ob.size THEN FixSize[ob, sz];
RETURN [ob]
};
OldFindFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] = {
FindFont:
PROC [name: Rope.
ROPE]
RETURNS [font: Imager.Font←
NIL] = {
font ← ImagerFont.Find[name !
Imager.Error => {font ← NIL; CONTINUE};
RuntimeError.UNCAUGHT => {font ← NIL; CONTINUE}
];
};
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 ← FindFont[name];
IF font=NIL THEN font ← FindFont[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)
--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]
}
};
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;
};
VeryOldReadText:
CD.InternalReadProc = {
OldReadFont:
PROC []
RETURNS [font:
REF CDTexts.FontRec] = {
--for version<=8
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 ← InternalMakeFont[name: name, scale: scale, approx: $old];
};
ob: CD.Object;
x: INT ← -1;
y: INT ← -1;
r: Rope.ROPE;
f: ATOM;
layer: CD.Layer ← CD.undefLayer;
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[];
layer ← CDIO.ReadLayer[];
r ← TokenIO.ReadRope[]
};
f ← TokenIO.ReadAtom[];
IF f#NIL THEN ERROR;
font ← OldReadFont[];
ob ← CreateText[text: r, font: font, layer: layer];
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]
};
[] ← CDProperties.RegisterProperty[$OriginalFont, $CDTextsImpl];
--cheat while the conversion...
CDProperties.PutProp[rigidTextClass, $SisyphExtractProc, $ExtractNull];
CDProperties.PutProp[rigidTextClass, $SinixCMosBExtractProc, $ExtractNull];
CDEvents.RegisterEventProc[$ReadTechnologyPrivate, ReadEvent];
END.
gbb April 4, 1986 3:46:03 pm PST
Added conversion of default layer for text