VFontsImpl.mesa
Copyright © 1982, 1983, 1984 by Xerox Corporation. All rights reserved.
Russ Atkinson, July 16, 1984 8:50:55 pm PDT
McGregor, October 4, 1982 11:16 am
Maxwell, January 3, 1983 1:07 pm
Paul Rovner, August 10, 1983 4:00 pm
Doug Wyatt, September 4, 1984 1:09:22 pm PDT
DIRECTORY
DefaultRemoteNames,
FS USING [Error, GetInfo, nullOpenFile, Open, OpenFile, Read],
Graphics USING [FontRef],
GraphicsOps USING [UnsafeNewFont],
IO USING [PutR, card],
Rope USING [Cat, Equal, Fetch, FromChar, Match, ROPE, Size],
DebuggerSwap USING [CallDebugger],
UserProfile USING [Number, Token],
VFonts;
VFontsImpl: CEDAR MONITOR
IMPORTS DefaultRemoteNames, FS, IO, GraphicsOps, Rope, DebuggerSwap, UserProfile, VFonts, VM
EXPORTS VFonts
SHARES VFonts
=
BEGIN
OPEN VFonts;
ROPE: TYPE = Rope.ROPE;
defaultFont: PUBLIC VFonts.Font ← NIL;
defaultGFont: PUBLIC Graphics.FontRef ← NIL;
Error: PUBLIC ERROR [code: VFonts.ErrorCode] = CODE;
fontChain: Font ← NIL;
FontChain: ENTRY PROC RETURNS[Font] ~ INLINE { RETURN[fontChain] };
AddFont: ENTRY PROC[font: Font] ~ { font.next ← fontChain; fontChain ← font };
Procedures
StringWidth:
PUBLIC
PROC [string:
ROPE, font: VFonts.Font ← defaultFont]
RETURNS [width: [0..LAST[INTEGER]]] = BEGIN
width ← 0;
FOR i:
INT
IN [0..Rope.Size[string])
DO
width ← width + VFonts.CharWidth[Rope.Fetch[string, i], font]
ENDLOOP;
END;
Initialize:
PROC [font: VFonts.Font] =
BEGIN
font.min ← xxx;
font.max ← xxx;
font.ascent ← xxx;
font.height ← xxx;
font.maxWidth ← xxx;
FOR c
IN [font.min..
MIN[font.max, 176C]]
DO
font.width[c] ← xxx
ENDLOOP;
FOR c IN [0C..font.min) DO font.width[c] ← font.width[font.min] ENDLOOP;
FOR c IN (MIN[font.max, 176C]..177C] DO font.width[c] ← font.width[font.min] ENDLOOP;
font.width[15C] ← font.width[40C]; -- CR width hack
END;
EstablishFont:
PUBLIC
PROC [family:
ROPE, size:
CARDINAL, bold:
BOOL ←
FALSE,
italic: BOOL ← FALSE, defaultOnFailure: BOOL ← TRUE]
RETURNS [font: Font] = BEGIN
IF size#10 AND Rope.Equal[family, "Tioga", FALSE] THEN family ← "TimesRoman";
horrible hack to compensate for lack of other size Tioga fonts
FOR font ← FontChain[], font.next
UNTIL font=
NIL
DO
IF size=font.size
AND bold=font.bold
AND
italic=font.italic
AND Rope.Equal[family, font.family,
FALSE]
THEN RETURN [font];
ENDLOOP;
RETURN[NewFont[family, size, bold, italic, defaultOnFailure]];
END;
NewFont:
PROC [family:
ROPE, size:
CARDINAL, bold, italic, defaultOnFailure:
BOOL]
RETURNS [font: Font] = BEGIN
scratch: REF TEXT ~ RefText.ObtainScratch[100];
trialName: REF TEXT ← scratch;
trialName ← RefText.AppendRope[trialName, family];
IF size#0 THEN trialName ← RefText.AppendTextRope[trialName, Convert.RopeFromCard[size]];
IF bold THEN trialName ← RefText.AppendChar[trialName, 'B];
IF italic THEN trialName ← RefText.AppendChar[trialName, 'I];
RefText.ReleaseScratch[scratch];
trialName: ROPE;
font.family ← family;
font.size ← size;
font.bold ← bold;
font.italic ← italic;
font.next ← fontChain;
fontChain ← font;
IF font.size=10
AND ~font.bold
AND ~font.italic
AND Rope.Equal[font.family, "Tioga",
FALSE]
THEN font.ascent ← 9; -- horrible patch to compensate for bad baseline
END;
LoadFont:
PROC [fileName:
ROPE]
RETURNS [font: Font] =
TRUSTED {
file: FS.OpenFile ← FS.nullOpenFile;
pages: INT;
space: VM.Interval;
explicitRemote: BOOL = Rope.Match["/*", fileName] OR Rope.Match["[*", fileName];
fontDir: ROPE = "<Tioga>StrikeFonts>";
remoteName1:
ROPE =
IF explicitRemote
THEN fileName
ELSE Rope.Cat[DefaultRemoteNames.Get[].systemHost, fontDir, fileName];
remoteName2:
ROPE =
IF explicitRemote
THEN fileName
ELSE Rope.Cat[DefaultRemoteNames.Get[].userHost, fontDir, fileName];
{
First, try to open the font with remote checking, since the remote file might have been updated since our last try at this font. Someday we will be able to determine this more efficiently. If we get an unknownFile error then we have no hope of getting it somewhere else, since the file server has responded that it is not there.
file ←
FS.Open[name: remoteName1, remoteCheck:
TRUE
! FS.Error => IF error.code = $unknownFile THEN GO TO Punt ELSE CONTINUE];
IF file # FS.nullOpenFile THEN GO TO gotIt;
IF
NOT explicitRemote
THEN {
Try the user host, since it might be up when the system host is down. Again, if we get an explicit failure we punt.
file ←
FS.Open[name: remoteName2, remoteCheck:
TRUE
! FS.Error => IF error.code = $unknownFile THEN GO TO Punt ELSE CONTINUE];
IF file # FS.nullOpenFile THEN GO TO gotIt;
};
At this point neither host is responding, but we might get lucky and have this font in our cache! In this case we are getting desperate, so we don't check the cache. If we find anything, then we are in luck!
file ← FS.Open[name: remoteName1, remoteCheck: FALSE ! FS.Error => CONTINUE];
IF file # FS.nullOpenFile THEN GO TO gotIt;
IF NOT explicitRemote THEN GO TO Punt;
file ← FS.Open[name: remoteName2, remoteCheck: FALSE ! FS.Error => CONTINUE];
IF file # FS.nullOpenFile THEN GO TO gotIt;
EXITS gotIt => {};
};
pages ← FS.GetInfo[file].pages;
IF pages >= maxFontSize THEN ERROR;
space ← VM.Allocate[count: pages];
font ← NEW[FontObject];
font.address ← VM.AddressForPageNumber[space.page];
FS.Read[file: file, from: 0, nPages: pages, to: font.address];
Initialize [font];
EXITS Punt => RETURN[NIL];
};
CopyFont: PROC [font: Font] RETURNS [Font] = INLINE {RETURN[NEW[FontObject ← font^]]};
CreateDefaultFont:
PROC =
BEGIN
err: BOOL ← FALSE;
defaultFamily: ROPE ← UserProfile.Token["DefaultFontFamily", "Tioga"];
defaultSize: CARDINAL ← UserProfile.Number["DefaultFontSize", 10];
defaultFont ← EstablishFont[defaultFamily, defaultSize,
FALSE
! ANY => {err ← TRUE; CONTINUE}];
IF err
AND (defaultSize#10
OR ~Rope.Equal["Tioga", defaultFamily,
FALSE])
THEN
BEGIN
substitute Tioga10.strike for user's failed choice
err ← FALSE;
defaultFont ← EstablishFont["Tioga", 10, FALSE ! FS.Error => CHECKED {err ← TRUE; CONTINUE}];
END;
IF err THEN DO TRUSTED {DebuggerSwap.CallDebugger["Couldn't get any fonts!"L]}; ENDLOOP;
defaultGFont ← defaultFont.gFont;
END;
CreateDefaultFont[];
END.