Copyright (C) 1994, Digital Equipment Corp.
by Steve Glassman, Mark Manasse and Greg Nelson
<*PRAGMA LL*>
UNSAFE MODULE NTScrnFont;
IMPORT Axis, Ctypes, Fmt, Font, M3toC, NT, NTScreenType,
NTScrnTpRep, Palette, Rect, ScreenType, ScrnFont, Text, TrestleComm,
TrestleOnNT ;
TYPE
DeepFontOracle =
ScrnFont.Oracle OBJECT
st: NTScreenType.T;
METHODS
init (st: NTScreenType.T): DeepFontOracle := DeepInitFontOracle;
(* LL = st.trsl *)
OVERRIDES
list := DeepFontList;
match := DeepFontMatch;
lookup := DeepFontLookup;
builtIn := DeepFontBuiltIn
END;
FontOracle =
ScrnFont.Oracle OBJECT
st: NTScreenType.T;
METHODS
init (st: NTScreenType.T): FontOracle RAISES {TrestleComm.Failure} := InitFontOracle;
(* LL = st.trsl *)
OVERRIDES
list := FontList;
match := FontMatch;
lookup := FontLookup;
builtIn := FontBuiltIn
END;
NTFont = ScrnFont.T;
PROCEDURE NewOracle (scrn: NTScreenType.T; depthOne := FALSE): ScrnFont.Oracle
RAISES {TrestleComm.Failure} =
BEGIN
IF depthOne THEN
RETURN NEW(FontOracle).init(scrn);
ELSE
RETURN NEW(DeepFontOracle).init(scrn);
END;
END NewOracle;
PROCEDURE DeepFontMatch (orc : DeepFontOracle;
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 RAISES {TrestleComm.Failure} =
BEGIN
RETURN orc.st.bits.font.match(
family, pointSize, slant, maxResults, weightName, version,
foundry, width, pixelsize, hres, vres, spacing, averageWidth,
charsetRegistry, charsetEncoding)
END DeepFontMatch;
PROCEDURE DeepFontList (orc: DeepFontOracle; pat: TEXT; maxResults: INTEGER):
REF ARRAY OF TEXT RAISES {TrestleComm.Failure} =
BEGIN
RETURN orc.st.bits.font.list(pat, maxResults)
END DeepFontList;
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 RAISES {TrestleComm.Failure} =
VAR fname: TEXT;
BEGIN
IF Text.Length(version) # 0 THEN
fname := "+" & version
ELSE
fname := ""
END;
fname := fname & "-" & foundry & "-" & family & "-" & weightName & "-";
CASE slant OF
ScrnFont.Slant.Roman => fname := fname & "R"
| ScrnFont.Slant.Italic => fname := fname & "I"
| ScrnFont.Slant.Oblique => fname := fname & "O"
| ScrnFont.Slant.ReverseItalic => fname := fname & "RI"
| ScrnFont.Slant.ReverseOblique => fname := fname & "RO"
| ScrnFont.Slant.Other => fname := fname & "OT"
| ScrnFont.Slant.Any => fname := fname & "*"
END;
fname := fname & "-" & width & "-*-" & Num(pixelsize) & Num(pointSize)
& ResNum(hres, orc.st.res[Axis.T.Hor])
& ResNum(vres, orc.st.res[Axis.T.Ver]);
CASE spacing OF
ScrnFont.Spacing.Proportional => fname := fname & "P"
| ScrnFont.Spacing.Monospaced => fname := fname & "M"
| ScrnFont.Spacing.CharCell => fname := fname & "C"
| ScrnFont.Spacing.Any => fname := fname & "*"
END;
fname := fname & "-" & Num(averageWidth) & charsetRegistry & "-"
& charsetEncoding;
RETURN orc.list(fname, maxResults)
END FontMatch;
PROCEDURE FontList (orc: FontOracle; pat: TEXT; maxResults: INTEGER):
REF ARRAY OF TEXT RAISES {TrestleComm.Failure} =
BEGIN
NT.Assert(0); (* NYI *)
END FontList;
PROCEDURE Num (n: INTEGER): TEXT =
BEGIN
IF n < 0 THEN RETURN "*-" ELSE RETURN Fmt.Int(n) & "-" END
END Num;
PROCEDURE ResNum (n: INTEGER; res: REAL): TEXT =
BEGIN
(* Gross hack to deal with the fact that all available fonts for X are
either scaled for 75 pixel per inch or 100 pixel per inch
displays *)
IF n = -2 THEN
RETURN Num(ROUND(res * 25.4 / 25.0) * 25)
ELSE
RETURN Num(n)
END
END ResNum;
PROCEDURE DeepFontLookup (orc: DeepFontOracle; name: TEXT): ScrnFont.T
RAISES {ScrnFont.Failure, TrestleComm.Failure} =
BEGIN
RETURN orc.st.bits.font.lookup(name)
END DeepFontLookup;
PROCEDURE FontLookup (orc: FontOracle; name: TEXT): ScrnFont.T
RAISES {ScrnFont.Failure, TrestleComm.Failure} =
BEGIN
NT.Assert(0); (* NYI *)
END FontLookup;
CONST
BuiltInNames = ARRAY OF
TEXT{
"-adobe-helvetica-medium-r-normal--*-100-*-*-p-*-iso8859-1",
"-*-helvetica-medium-r-*-*-*-10?-*-*-*-*-iso8859-1",
"-*-times-medium-r-*-*-*-10?-*-*-*-*-iso8859-1",
"fixed", "-*-helvetica-*-r-*-*-*-11?-*-*-*-*-iso8859-1",
"-*-helvetica-*-r-*-*-*-12?-*-*-*-*-iso8859-1",
"-*-helvetica-*-r-*-*-*-1??-*-*-*-*-iso8859-?",
"-*-times-*-r-*-*-*-1??-*-*-*-*-iso8859-?", "timrom1?",
"times_roman1?", "*"};
PROCEDURE DeepFontBuiltIn (orc: DeepFontOracle; id: Font.Predefined):
ScrnFont.T =
BEGIN
RETURN Palette.ResolveFont(orc.st.bits, Font.T{id})
END DeepFontBuiltIn;
PROCEDURE FontBuiltIn (orc: FontOracle; id: Font.Predefined): ScrnFont.T =
BEGIN
IF id # Font.BuiltIn.fnt THEN Crash() END;
RETURN
NEW(ScrnFont.T, id := 0,
metrics := NEW(NullMetrics,
minBounds := ScrnFont.CharMetric{0, Rect.Empty},
maxBounds := ScrnFont.CharMetric{0, Rect.Empty},
firstChar := 0, lastChar := 0,
selfClearing := TRUE, charMetrics := NIL))
END FontBuiltIn;
TYPE
NullMetrics = ScrnFont.Metrics OBJECT
OVERRIDES
intProp := NullIntProp;
textProp := NullTextProp
END;
PROCEDURE NullIntProp (<*UNUSED*> self: NullMetrics;
<*UNUSED*> name: TEXT;
<*UNUSED*> ch : INTEGER := -1): INTEGER
RAISES {ScrnFont.Failure} =
BEGIN
RAISE ScrnFont.Failure
END NullIntProp;
PROCEDURE NullTextProp (<*UNUSED*> self: NullMetrics;
<*UNUSED*> name: TEXT;
<*UNUSED*> ch : INTEGER := -1): TEXT
RAISES {ScrnFont.Failure} =
BEGIN
RAISE ScrnFont.Failure
END NullTextProp;
PROCEDURE InitFontOracle (orc: FontOracle; st: NTScreenType.T): FontOracle
RAISES {TrestleComm.Failure} =
BEGIN
orc.st := st;
RETURN orc
END InitFontOracle;
PROCEDURE DeepInitFontOracle (orc: DeepFontOracle; st: NTScreenType.T):
DeepFontOracle =
BEGIN
orc.st := st;
RETURN orc
END DeepInitFontOracle;
EXCEPTION FatalError;
PROCEDURE Crash() =
<* FATAL FatalError *>
BEGIN
RAISE FatalError;
END Crash;
BEGIN
END NTScrnFont.