<> <> <> <> <> <> <> 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 }; <> 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"; <> 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 = "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]; { <> 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 { <> 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; }; <> 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 <> 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.