<> <> <<>> <> <> <> <> 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, VM USING [Interval, Allocate, AddressForPageNumber]; VFontsImpl: CEDAR PROGRAM 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; Strike: TYPE = LONG POINTER TO StrikeObject; StrikeObject: TYPE = RECORD [header: StrikeHeader, body: StrikeBody]; StrikeHeader: TYPE = RECORD [ bits: StrikeBits, min: CARDINAL, max: CARDINAL, maxwidth: CARDINAL]; StrikeBits: TYPE = RECORD [ newStyle: BOOL, indexed: BOOL, fixed: BOOL, kerned: BOOL, pad: [0..7777B]]; BoundingBox: TYPE = RECORD [ FontBBox, FontBBoy, FontBBdx, FontBBDy: INTEGER]; StrikeBody: TYPE = RECORD [ length: CARDINAL, ascent: CARDINAL, descent: CARDINAL, xoffset: CARDINAL, raster: CARDINAL, bitmap: ARRAY [0..0) OF WORD]; maxFontSize: CARDINAL _ 256; <> <> 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] = TRUSTED BEGIN strike: Strike = font.address; c: CHARACTER; bits: StrikeBits = strike.header.bits; IF ~bits.newStyle THEN ERROR Error[illegalFormat]; IF bits.indexed THEN ERROR Error[illegalFormat]; font.kerned _ bits.kerned; font.min _ LOOPHOLE[strike.header.min]; font.max _ LOOPHOLE[strike.header.max]; IF font.min NOT IN [0C..177C] THEN ERROR Error[illegalFormat]; IF font.max NOT IN [0C..177C] THEN ERROR Error[illegalFormat]; font.ascent _ strike.body.ascent; font.height _ strike.body.ascent + strike.body.descent; font.raster _ strike.body.raster; font.maxWidth _ strike.header.maxwidth; SetFontAddresses[font]; FOR c IN [font.min..MIN[font.max, 176C]] DO font.width[c] _ XInSegment[c+1, font] - XInSegment[c, font] 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; SetFontAddresses: PROC [font: Font] = TRUSTED INLINE BEGIN strike: Strike = font.address; font.bitmap _ @strike.body.bitmap + (IF font.kerned THEN SIZE[BoundingBox] ELSE 0); font.xInSegment _ LOOPHOLE[font.bitmap, LONG POINTER] + font.raster*font.height - LOOPHOLE[font.min, INTEGER]; END; fontChain: Font _ NIL; 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 trialName: ROPE; IF bold OR italic THEN BEGIN trialName _ Rope.Cat[trialName, family]; IF size#0 THEN trialName _ Rope.Cat[trialName, IO.PutR[IO.card[size]]]; IF bold THEN trialName _ Rope.Cat[trialName, Rope.FromChar['B]]; IF italic THEN trialName _ Rope.Cat[trialName, Rope.FromChar['I]]; trialName _ Rope.Cat[trialName, ".strike"]; IF (font _ LoadFont[trialName]) = NIL THEN BEGIN -- try to match size&family FOR f: Font _ fontChain, f.next UNTIL f=NIL DO IF size=f.size AND ~f.bold AND ~f.italic AND Rope.Equal[family, f.family, FALSE] THEN { font _ CopyFont[f]; IF bold THEN font.synthBold _ TRUE; IF italic THEN font.synthItalic _ TRUE; EXIT}; ENDLOOP; END; IF font=NIL THEN -- lose, give up {IF ~defaultOnFailure THEN Error[fontNotFound] ELSE trialName _ NIL} ELSE IF font.gFont=NIL THEN TRUSTED { font.gFont _ LOOPHOLE[GraphicsOps.UnsafeNewFont[font.address]]}; END; IF font=NIL THEN BEGIN -- no luck yet trialName _ Rope.Cat[trialName, family]; IF size#0 THEN trialName _ Rope.Cat[trialName, IO.PutR[IO.card[size]]]; trialName _ Rope.Cat[trialName, ".strike"]; IF (font _ LoadFont[trialName])=NIL THEN -- lose {IF ~defaultOnFailure THEN Error[fontNotFound] ELSE font _ CopyFont[defaultFont]} ELSE TRUSTED {font.gFont _ LOOPHOLE[GraphicsOps.UnsafeNewFont[font.address]]}; IF bold THEN font.synthBold _ TRUE; IF italic THEN font.synthItalic _ TRUE; END; 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.