XlFontOpsImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 18, 1988 11:22:01 am PDT
Christian Jacobi, February 3, 1993 11:56 am PST
DIRECTORY
Basics,
Customize,
Rope,
Xl,
XlDetails,
XlFontOps,
XlDB;
XlFontOpsImpl:
CEDAR
MONITOR
IMPORTS Basics, Customize, Rope, Xl, XlDB, XlDetails
EXPORTS XlFontOps =
BEGIN OPEN XlFontOps;
myKey: REF INT ~ NEW[INT];
Init: Xl.InitializeProcType = {
rf: REF Xl.Font ¬ NEW[Xl.Font ¬ NIL];
XlDB.RegisterDBInvalidator[c, InvalidateDB, NIL];
RETURN [rf]
};
InvalidateDB: Xl.EventProcType = {
rf: REF Xl.Font ¬ NARROW[Xl.GetConnectionProp[event.connection, myKey]];
IF rf#NIL THEN rf ¬ Xl.nullFont;
};
NiceOpenFont:
PROC [c: Xl.Connection, name: Rope.
ROPE]
RETURNS [font: Xl.Font ¬ Xl.nullFont] = {
font ¬ Xl.OpenFont[c, name, XlDetails.synchronousErrors ! Xl.XError => GOTO Oops];
EXITS Oops => RETURN [Xl.nullFont];
};
GetDefaultFont:
PUBLIC
PROC [c: Xl.Connection]
RETURNS [font: Xl.Font] = {
rf: REF Xl.Font ¬ NARROW[Xl.GetConnectionPropAndInit[c, myKey, Init]];
Each:
PROC [name: Rope.
ROPE, data:
REF ¬
NIL]
RETURNS [quit:
BOOL] = {
font ¬ NiceOpenFont[c, name];
quit ¬ font#Xl.nullFont
};
IF rf=NIL THEN RETURN [Xl.nullFont];
font ¬ rf;
IF font=Xl.nullFont
THEN {
dbx: Customize.DBreadonly ¬ XlDB.GetStandardDB[c];
fontName: Rope.ROPE ¬ NIL;
WITH Customize.DoQueryString[dbx, "(Cedar)(defaultFont)"]
SELECT
FROM
r: Rope.ROPE => fontName ¬ r;
ENDCASE => {};
IF Rope.IsEmpty[fontName] THEN fontName ¬ "8x13";
[] ¬ Each[fontName, NIL];
IF font=Xl.nullFont
THEN {
--Try hard. Don't crash simply because fonts are not loaded
--It will be obvious if a bad font is chosen
IF ~Rope.Equal[fontName, "8x13"] THEN [] ¬ Each["8x13", NIL];
IF font=Xl.nullFont THEN [] ¬ Each["serif12", NIL];
IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*adobe-helvetica-medium*normal--12*", 3];
IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*helvetica*", 3];
IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*times*", 3];
IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*", 5];
};
IF font#Xl.nullFont --don't overwrite old, possibly good default-- THEN rf ¬ font;
}
};
QueryPosInfo:
PUBLIC
PROC [c: Xl.Connection, font: Xl.Fontable, text: Rope.
ROPE, x:
INT]
RETURNS [p: PosInfo ¬ [0, 0, 0]] = {
fi: REF READONLY Xl.FontInfoRec ¬ Xl.QueryFont[c, font];
IF fi#NIL THEN p ¬ FindIdx[fi, text, x];
};
CharIsDefined:
PROC [attributes:
CARD16]
RETURNS [
BOOL] =
INLINE {
undocumentedNonExistChar:
CARD16 = 04000H;
--Protocol says server dependent
--This numerical value copied from /net/pooh/pooh/X11R3/share/lib/X/XTextExt16.c
RETURN [ (Basics.BITAND[attributes, undocumentedNonExistChar]=0) ]
};
FindIdx:
PROC [fi:
REF
READONLY Xl.FontInfoRec, text: Rope.
ROPE, xPos:
INT]
RETURNS [pi: PosInfo ¬ [0, 0, 0]] = {
charPos: INT ¬ 0;
overallRight, overallWidth, lastOverallRight: INT ¬ 0;
firstCol: INT ~ fi.minCharOrByte2;
numCols: INT ~ fi.maxCharOrByte2-firstCol+1;
length: INT ~ Rope.Length[text];
idx: INT;
DO
IF charPos>=length THEN RETURN [[charPos, charPos, overallRight]];
idx ¬ ORD[Rope.Fetch[text, charPos]]; idx ¬ idx - firstCol;
IF idx<0
OR idx>=numCols
OR (fi.charInfos#
NIL
AND fi.charInfos.size>idx
AND ~CharIsDefined[fi.charInfos[idx].attributes])
THEN {
idx ¬ fi.defaultChar; idx ¬ idx - firstCol;
IF idx<0 OR idx >= numCols THEN {charPos ¬ charPos+1; LOOP}; --char won't be printed
};
TRUSTED {
p: LONG POINTER TO READONLY Xl.CharInfoRec;
IF fi.charInfos#
NIL
AND idx<fi.charInfos.size
THEN p ¬ LOOPHOLE[fi.charInfos, LONG POINTER]+UNITS[Xl.CharInfoSequence[0]]+idx*UNITS[Xl.CharInfoRec]
ELSE p ¬ LOOPHOLE[fi.minBounds, LONG POINTER];
IF ~CharIsDefined[p.attributes] THEN {charPos ¬ charPos+1; LOOP}; --char won't be printed
lastOverallRight ¬ overallRight;
overallRight ¬ MAX[overallRight, overallWidth+p.rightBearing];
overallWidth ¬ overallWidth+p.charWidth;
};
charPos ¬ charPos+1;
IF overallRight>=xPos
THEN {
IF (overallRight-xPos)<(xPos-lastOverallRight)
THEN RETURN [[gapIndex: charPos, charIndex: charPos-1, gapX: overallRight]]
ELSE RETURN [[gapIndex: charPos-1, charIndex: charPos-1, gapX: lastOverallRight]];
};
ENDLOOP;
};
END.