<*PRAGMA LL*> MODULE; IMPORT ScrnFont, JoinScreen, Font, Rect, Palette, PlttFrnds, VBTRep; PROCEDURE JoinFont New (st: JoinScreen.T): Oracle = BEGIN RETURN NEW(Oracle, st := st) END New; PROCEDUREResolve (st: JoinScreen.T; fnt: Font.T) = VAR i: INTEGER; t := st.succ(NIL, i); BEGIN WHILE t # NIL DO EVAL Palette.ResolveFont(t, fnt); t := st.succ(t, i) END END Resolve; PROCEDUREApply ( st : JoinScreen.T; <*UNUSED*> cl : Palette.FontClosure; fnt: Font.T ): ScrnFont.T = VAR res := st.fonts[fnt.fnt]; BEGIN Resolve(st, fnt); IF res = NIL OR res = PlttFrnds.noFont THEN res := NEW(T, id := 2 * fnt.fnt + 1, st := st) END; VAR i: INTEGER; t := st.succ(NIL, i); BEGIN IF t = NIL THEN res.metrics := EmptyMetrics ELSE res.metrics := Palette.ResolveFont(t, fnt).metrics END END; RETURN res END Apply; REVEAL Oracle = ScrnFont.Oracle BRANDED OBJECT st: JoinScreen.T; (* OVERRIDES match := Match; list := List; lookup := Lookup; builtIn := BuiltIn *) END; TYPE T = ScrnFont.T OBJECT st: JoinScreen.T; (* OVERRIDES localize := Localize; unload := Unload *) END;
PROCEDURE FontMatch(orc: FontOracle; family: TEXT; pointSize: INTEGER; slant: ScrnFont.Slant; maxResults: CARDINAL; weightName: TEXT; version: TEXT; foundry: TEXT; width: TEXT; pixelsize: INTEGER; hres, vres: INTEGER; spacing: ScrnFont.Spacing; averageWidth: INTEGER; charsetRegistry: TEXT; charsetEncoding: TEXT) : REF ARRAY OF TEXT = BEGIN IF orc.st.sts = NIL THEN Crash(); END; RETURN orc.st.sts[0].font.match(family, pointSize, slant, maxResults, weightName, version, foundry, width, pixelsize, hres, vres, spacing, averageWidth, charsetRegistry, charsetEncoding); END FontMatch;
PROCEDURE FontBuiltIn(orc: FontOracle; id: Font.Predefined): ScrnFont.T = BEGIN IF orc.st.sts = NIL THEN Crash(); END; RETURN orc.st.sts[0].font.builtIn(id); END FontBuiltIn;
PROCEDURE FontList(orc: FontOracle; pat: TEXT; maxResults: INTEGER) : REF ARRAY OF TEXT = BEGIN IF orc.st.sts = NIL THEN Crash(); END; RETURN orc.st.sts[0].font.list(pat, maxResults); END FontList;
PROCEDURE FontLookup(orc: FontOracle; name: TEXT): ScrnFont.T = BEGIN IF orc.st.sts = NIL THEN Crash(); END; RETURN orc.st.sts[0].font.lookup(name); END FontLookup;
EXCEPTION FatalError;
PROCEDURE Crash () = <* FATAL FatalError *> BEGIN RAISE FatalError; END Crash;
VAR EmptyMetrics := NEW(NullMetrics, minBounds := ScrnFont.CharMetric{0, Rect.Empty}, maxBounds := ScrnFont.CharMetric{0, Rect.Empty}, firstChar := 0, lastChar := 0, selfClearing := TRUE, charMetrics := NIL); TYPE NullMetrics = ScrnFont.Metrics OBJECT OVERRIDES intProp := NullIntProp; textProp := NullTextProp END; PROCEDURENullIntProp (<*UNUSED*> self: NullMetrics; <*UNUSED*> name: TEXT; <*UNUSED*> ch : INTEGER := -1): INTEGER RAISES {ScrnFont.Failure} = BEGIN RAISE ScrnFont.Failure END NullIntProp; PROCEDURENullTextProp (<*UNUSED*> self: NullMetrics; <*UNUSED*> name: TEXT; <*UNUSED*> ch : INTEGER := -1): TEXT RAISES {ScrnFont.Failure} = BEGIN RAISE ScrnFont.Failure END NullTextProp; BEGIN END JoinFont.