Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Tue Jan 17 16:36:36 PST 1995 by najork
UNSAFE MODULE; IMPORT Ctypes, Fingerprint, FloatMode, Fmt, Font, Lex, M3toC, PaintPrivate, Rect, Scan, ScrnFont, Text, WinDef, WinGDI, WinUser, Word; EXCEPTION FatalError; <* FATAL FatalError *> WinScrnFont
The WinScrnFont module implements Windows-specific subclasses to
screen-fonts and screen font oracles. The client can ask for all
available fonts that match a certain, and can request a specific
font. Unfortunately, the attributes used by Trestle to characterize a
font are modeled very closely after the corresponding X attributes,
and do not quite match the attributes Windows uses for characterizing
a font. A second problem is that Windows has no function for looking
up a font that matches a pattern with wildcards
.
There are three formats for describing fonts: - X font description strings - Trestle ScrnFont.Metrics records - Windows WinGDI.LOGFONT records
An X font specification string has the following format: -fndry-fmly-wght-slant-sWdth-adstyl-pxlsz-ptsz-resx-resy-spc-avgWdth-rgstry-encdng
The following attributes are (more or less) common to X, Trestle, and Windows:
X Logigal Font Description ScrnFont.Metrics field: WinGDI.LOGFONT field: Foundry foundry ----- Family family lfFaceName Weight weightName lfWeight Slant slant lfItalic sWidth width ----- adstyl ----- ----- Pixel Size pixelsize ----- Point Size pointSize lfHeight Hor. Resolution hres ----- Ver. Resolution vres ----- Spacing spacing lfPitchAndFamily Avg. Width averageWidth lfWidth CharSet Registry charsetRegistry ----- CharSet Enconding charsetEncoding lfCharSet
There is a way to enumerate all installed Windows fonts, but this method does not return all the available point sizes for a TrueType font (I don't know if it simplifies anything else).
We adopt the following policies:
(1) The following 7 attributes are used to map a font description string to a
Windows font:
Family, Weight, Slant, Point Size, Spacing, Width, and Character Set
(2) At startup, we enumerate all available fonts and build up a list of
font description strings. For all the X attributes that are unspecified
in Windows world, we fill in a *
. In addition, if the font is a
TrueType font, we set the Point Size to *
.
PROCEDURENewOracle (): ScrnFont.Oracle = BEGIN RETURN NEW (Oracle); END NewOracle; TYPE Oracle = ScrnFont.Oracle BRANDED OBJECT OVERRIDES list := List; match := Match; lookup := Lookup; builtIn := BuiltIn; END; PROCEDUREList (<*UNUSED*> self : Oracle; pat : TEXT; maxResults: INTEGER): REF ARRAY OF TEXT = <* FATAL BadFontName *> VAR res := NEW (REF ARRAY OF TEXT, maxResults); cnt := 0; BEGIN FOR i := FIRST (FontNames^) TO LAST (FontNames^) DO IF MatchingNames (pat, FontNames[i]) THEN res[cnt] := FontNames[i]; INC (cnt); IF cnt > maxResults THEN EXIT; END; END; END; IF cnt > maxResults THEN RETURN res; ELSE WITH tmp = NEW (REF ARRAY OF TEXT, cnt) DO tmp^ := SUBARRAY (res^, 0, cnt); RETURN tmp; END; END; END List;
* Match
is almost an exact copy of the XScrnFont.FontMatch
procedure.
PROCEDURE***************************************************************************** * *Match (self : Oracle; 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 = PROCEDURE Num (n: INTEGER): TEXT = BEGIN IF n < 0 THEN RETURN "*-" ELSE RETURN Fmt.Int(n) & "-" END; END Num; 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) & Num(hres) & Num(vres); 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 List (self, fname, maxResults) END Match; PROCEDURELookup (<* UNUSED *> self: Oracle; name: TEXT): ScrnFont.T RAISES {ScrnFont.Failure} = BEGIN TRY WITH res = NameToScrnFont (name) DO IF res = NIL THEN RAISE ScrnFont.Failure; ELSE RETURN res; END; END; EXCEPT BadFontName => RAISE ScrnFont.Failure; END; END Lookup;
BuiltIn
returns a default screen font. The xvbt implementation goes
* through an array of hardwired font patterns, determines if the X server
* offers any of these fonts, takes the first match, converts it into a
* ScrnFont.T
, and returns it. If there is no match, it raises a fatal
* error. The font selection is protected by the trsl
mutex.
*
* The Windows implementation first checks if one of the fonts from a list
* of preferred fonts is available, and picks the first match. If there is
* no match, it will pick any font. (Note that there is always at least one
* font -- Windows must have some fonts to draw window frames and menu bars).
* It then converts the Windows font into a ScrnFont.T
, and returns it.
*
****************************************************************************
CONST Preferred = "-*-Arial-Normal-R-*-*-*-12-*-*-P-*-iso8859-ANSI"; PROCEDURE*************************************************************************** DetermineFontNames This procedure is called by Init. It enumerates all the available Windows fonts, converts them into font names (font description strings), and stores these names in an array. ***************************************************************************BuiltIn (self: Oracle; id: Font.Predefined): ScrnFont.T = BEGIN IF id # Font.BuiltIn.fnt THEN RAISE FatalError END; TRY (* * Once "list" is implemented, we should allow for an array of * preferred fonts. *) RETURN Lookup (self, Preferred); EXCEPT | ScrnFont.Failure => 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; END BuiltIn; CONST False = 0; True = 1; PROCEDUREFromFont (font: PaintPrivate.Font): WinDef.HFONT = BEGIN RETURN LOOPHOLE (font, WinDef.HFONT); END FromFont;
TYPE EnumRec = RECORD hdc: WinDef.HDC; ctr: INTEGER := 0; END; EnumRecPtr = UNTRACED REF EnumRec; VAR FontNames : REF ARRAY OF TEXT; PROCEDURE*************************************************************************** Procedure MatchingNames ***************************************************************************DetermineFontNames () = VAR er : EnumRec; status: WinDef.BOOL; BEGIN er.ctr := 0; WITH hwnd = WinUser.GetDesktopWindow() DO er.hdc := WinUser.GetDC(hwnd); <* ASSERT er.hdc # NIL *> (* First, count how many fonts are installed *) EVAL WinGDI.EnumFontFamilies(er.hdc, NIL, LOOPHOLE(CountFamProc, WinGDI.FONTENUMPROC), LOOPHOLE(ADR(er), WinDef.LPARAM)); (* Create space for them *) FontNames := NEW (REF ARRAY OF TEXT, er.ctr); (* Reset the counter and fill in the fonts *) er.ctr := 0; EVAL WinGDI.EnumFontFamilies(er.hdc, NIL, LOOPHOLE (InitFamProc, WinGDI.FONTENUMPROC), LOOPHOLE (ADR(er), WinDef.LPARAM)); (* release the desktop device context *) status := WinUser.ReleaseDC (hwnd, er.hdc); <* ASSERT status = 1 *> END; END DetermineFontNames; <* CALLBACK *> PROCEDUREInitFamProc ( lpelf : WinGDI.LPENUMLOGFONT; <* UNUSED *> lpntm : WinGDI.LPNEWTEXTMETRIC; <* UNUSED *> type : Ctypes.int; lparam: WinDef.LPARAM): Ctypes.int = VAR erp := LOOPHOLE (lparam, EnumRecPtr); BEGIN EVAL WinGDI.EnumFontFamilies (erp.hdc, LOOPHOLE (ADR (lpelf.elfLogFont.lfFaceName), Ctypes.char_star), LOOPHOLE (InitFontProc, WinGDI.FONTENUMPROC), lparam); RETURN 1; END InitFamProc; <* CALLBACK *> PROCEDUREInitFontProc ( lpelf : WinGDI.LPENUMLOGFONT; <* UNUSED *> lpntm : WinGDI.LPNEWTEXTMETRIC; type : Ctypes.int; lparam: WinDef.LPARAM): Ctypes.int = VAR erp := LOOPHOLE (lparam, EnumRecPtr); BEGIN IF Word.And (type, WinGDI.TRUETYPE_FONTTYPE) # 0 THEN FontNames[erp.ctr] := LogFontToName (lpelf.elfLogFont); INC (erp.ctr); END; RETURN 1; END InitFontProc; <* CALLBACK *> PROCEDURECountFamProc ( lpelf : WinGDI.LPENUMLOGFONT; <* UNUSED *> lpntm : WinGDI.LPNEWTEXTMETRIC; <* UNUSED *> type : Ctypes.int; lparam: WinDef.LPARAM): Ctypes.int = VAR erp := LOOPHOLE (lparam, EnumRecPtr); BEGIN EVAL WinGDI.EnumFontFamilies(erp.hdc, LOOPHOLE (ADR (lpelf.elfLogFont.lfFaceName), Ctypes.char_star), LOOPHOLE (CountFontProc, WinGDI.FONTENUMPROC), lparam); RETURN 1; END CountFamProc; <* CALLBACK *> PROCEDURECountFontProc (<* UNUSED *> lpelf : WinGDI.LPENUMLOGFONT; <* UNUSED *> lpntm : WinGDI.LPNEWTEXTMETRIC; type : Ctypes.int; lparam: WinDef.LPARAM): Ctypes.int = VAR erp := LOOPHOLE (lparam, EnumRecPtr); BEGIN IF Word.And (type, WinGDI.TRUETYPE_FONTTYPE) # 0 THEN INC (erp.ctr); END; RETURN 1; END CountFontProc; PROCEDURELogFontToName (READONLY lf: WinGDI.LOGFONT): TEXT = PROCEDURE ToRegistry (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN IF lf.lfCharSet = WinGDI.ANSI_CHARSET THEN RETURN "iso8859"; ELSE RETURN "Unknown"; END; END ToRegistry; BEGIN RETURN "" & (* Version *) "-*" & (* Foundry *) "-" & ToFamily (lf) & (* Family Name *) "-" & ToWeight (lf) & (* Weight Name *) "-" & ToSlant (lf) & (* Slant *) "-*" & (* Setwidth Name *) "-*" & (* Add Style Name *) "-*" & (* Pixel Size *) "-" & ToPointSize (lf) & (* Point Size *) "-*" & (* Resolution X *) "-*" & (* Resolution Y *) "-" & ToSpacing (lf) & (* Spacing *) "-" & ToWidth (lf) & (* Average Width *) "-" & ToRegistry (lf) & (* Charset Registry *) "-" & ToEncoding (lf); (* Charset Encoding *) END LogFontToName; PROCEDURENameToLogFont (name: TEXT): WinGDI.LOGFONT RAISES {BadFontName} = VAR parts: ARRAY [1..15] OF TEXT; BEGIN FanoutName (name, parts); RETURN WinGDI.LOGFONT {lfHeight := FromPointSize (parts[9]), lfWidth := FromWidth (parts[13]), lfEscapement := 0, lfOrientation := 0, lfWeight := FromWeight (parts[4]), lfItalic := FromSlant (parts[5]), lfUnderline := False, lfStrikeOut := False, lfCharSet := FromEncoding (parts[15]), lfOutPrecision := WinGDI.OUT_DEFAULT_PRECIS, lfClipPrecision := WinGDI.CLIP_DEFAULT_PRECIS, lfQuality := WinGDI.DEFAULT_QUALITY, lfPitchAndFamily:= FromSpacing (parts[12]), lfFaceName := FromFamily (parts[3])}; END NameToLogFont; PROCEDURENameToScrnFont (name: TEXT): ScrnFont.T RAISES {BadFontName} = BEGIN RETURN LogFontToScrnFont (NameToLogFont (name)); END NameToScrnFont; PROCEDURELogFontToScrnFont (READONLY lf: WinGDI.LOGFONT): ScrnFont.T = PROCEDURE ToSlant (READONLY lf: WinGDI.LOGFONT): ScrnFont.Slant = BEGIN IF lf.lfItalic = True THEN RETURN ScrnFont.Slant.Italic; ELSE RETURN ScrnFont.Slant.Roman; END; END ToSlant; PROCEDURE ToSpacing (READONLY lf: WinGDI.LOGFONT): ScrnFont.Spacing = BEGIN IF Word.And (lf.lfPitchAndFamily, WinGDI.FIXED_PITCH) # 0 THEN RETURN ScrnFont.Spacing.Monospaced ELSIF Word.And (lf.lfPitchAndFamily, WinGDI.VARIABLE_PITCH) # 0 THEN RETURN ScrnFont.Spacing.Proportional ELSE RETURN ScrnFont.Spacing.Any END END ToSpacing; PROCEDURE ToCharsetEncoding (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN CASE lf.lfCharSet OF | WinGDI.ANSI_CHARSET => RETURN "ANSI"; | WinGDI.UNICODE_CHARSET => RETURN "UNICODE"; | WinGDI.SYMBOL_CHARSET => RETURN "SYMBOL"; | WinGDI.SHIFTJIS_CHARSET => RETURN "SHIFTJIS"; | WinGDI.HANGEUL_CHARSET => RETURN "HANGEUL"; | WinGDI.CHINESEBIG5_CHARSET => RETURN "CHINESEBIG5"; | WinGDI.OEM_CHARSET => RETURN "OEM"; ELSE RETURN "Unknown"; END; END ToCharsetEncoding; PROCEDURE ToCharMetric (abc : WinGDI.ABC; READONLY m: ScrnFont.Metrics; VAR cm : ScrnFont.CharMetric) = BEGIN cm.printWidth := abc.abcA + abc.abcB + abc.abcC; WITH bb = cm.boundingBox DO bb.west := abc.abcA; bb.east := abc.abcA + abc.abcB; bb.north := -m.ascent; bb.south := m.descent; IF bb.west >= bb.east OR bb.north >= bb.south THEN bb := Rect.Empty; END; END; END ToCharMetric; PROCEDURE MinMaxMetric (READONLY cm : ScrnFont.CharMetric; VAR min, max : ScrnFont.CharMetric) = BEGIN min.printWidth := MIN (min.printWidth, cm.printWidth); max.printWidth := MAX (max.printWidth, cm.printWidth); min.boundingBox.west := MAX (min.boundingBox.west, cm.boundingBox.west); max.boundingBox.west := MIN (max.boundingBox.west, cm.boundingBox.west); min.boundingBox.east := MIN (min.boundingBox.east, cm.boundingBox.east); max.boundingBox.east := MAX (max.boundingBox.east, cm.boundingBox.east); END MinMaxMetric; VAR hfont := WinGDI.CreateFontIndirect (ADR(lf)); res := NEW (ScrnFont.T, id := LOOPHOLE (hfont, INTEGER), metrics := NEW (NullMetrics)); tm : WinGDI.NEWTEXTMETRIC; (* superset of TEXTMETRIC *) abcs : REF ARRAY OF WinGDI.ABC; cms : REF ARRAY OF ScrnFont.CharMetric; BEGIN IF hfont = NIL THEN RETURN NIL; END; (* Get the TEXTMETRIC or NEWTEXTMETRIC record for the font *) VAR hdc : WinDef.HDC; oldFont: WinDef.HFONT; status : Ctypes.int; BEGIN WITH hwnd = WinUser.GetDesktopWindow() DO hdc := WinUser.GetDC(hwnd); <* ASSERT hdc # NIL *> oldFont := WinGDI.SelectObject (hdc, hfont); <* ASSERT oldFont # NIL *> status := WinGDI.GetTextMetrics (hdc, LOOPHOLE (ADR(tm), WinGDI.LPTEXTMETRIC)); <* ASSERT status = True *> WITH first = tm.tmFirstChar, last = tm.tmLastChar DO abcs := NEW (REF ARRAY OF WinGDI.ABC, last - first + 1); status := WinGDI.GetCharABCWidths (hdc, first, last, ADR(abcs[0])); <* ASSERT status = True *> END; oldFont := WinGDI.SelectObject (hdc, oldFont); <* ASSERT oldFont = hfont *> status := WinUser.ReleaseDC (hwnd, hdc); <* ASSERT status = 1 *> END; END; WITH m = res.metrics DO m.family := M3toC.CopyStoT (LOOPHOLE (ADR (lf.lfFaceName), Ctypes.char_star)); (* In X, instances of "family" are "Times" or "Helvetica". In Windows, the closest counterpart is the "typeface". *) m.pointSize := lf.lfHeight; (* The Windows documentation is vague about point sizes (although it uses the term). From what I could make out, the point size of a font is equivalent to the height of the font. *) m.slant := ToSlant (lf); (* X has 6 different "slant" codes ("Roman", "Italic", "Oblique", "Reverse Italic", "Reverse Oblique", "Other"). Trestle has those six codes plus a 7th ("Any"). It seems that Windows only distinguishes between "Roman" and "Italic". *) m.weightName := ToWeight(lf); (* In Trestle and X, instances of "weight" name are "Bold", "DemiBold", and "Medium". Windows has the concept of weights, and predefined constants for some weights. *) m.version := ""; (* "version" was intended to indicate the version of the "X Logical Font Description Conventions". A blank is ok here. *) m.foundry := "Windows"; (* In X, the "foundry" indicates the manufacturer of a font (e.g. "Adobe" or "DEC"). There is no foundry field in a Windows "LOGFONT" record (although there is a "Vendor ID" in the "EXTLOGFONT" record). Trestle doesn't actually care about the value of foundry. *) m.width := "Unknown"; (* In X, "width" can have values such as "Narrow" or "Condensed". Windows "LOGFONT" structures don't have anything similar. Trestle doesn't actually seem to care. *) m.pixelsize := 0; m.hres := 0; m.vres := 0; (* In X, the pixel size, horizontal resolution, and vertical resolution of a font are known. This is not true for Windows logical fonts. Trestle does not actually care. *) m.spacing := ToSpacing (lf); (* The X term "spacing" and the Windows term "pitch" are roughly synonymous. X knows three spacings ("Proportional", "Monospaced", and "CharCell"); Windows knows three pitches ("DEFAULT", "FIXED", and "VARIABLE". Trestle does not care about spacings; they are used only for font matching. *) m.averageWidth := lf.lfWidth; (* X "average width" and Windows LOGFONT "width" seem to be pretty much the same. *) m.charsetRegistry := "Unknown"; (* In X, "charsetRegistry" identifies the registration authority for the character set. There is no such concept in Windows. Trestle doesn't actually care. *) m.charsetEncoding := ToCharsetEncoding(lf); (* In X, "charsetEncoding" is a text property defined by the authority that issued the font. Trestle does not care about the content; it is used only for font matching. We use it to encode the LOGFONT "lfCharSet" field. *) m.isAscii := lf.lfCharSet = WinGDI.ANSI_CHARSET; (* True if the character set is the aka ANSI, aka ISO8859 character set. "isAscii" is actually a misnomor, ASCII is a 7-bit code, whereas ANSI and ISO8859 are 8-bit codes. *) m.firstChar := tm.tmFirstChar; m.lastChar := tm.tmLastChar; m.defaultChar := tm.tmDefaultChar; m.ascent := tm.tmAscent; m.descent := tm.tmDescent; (* Fill in the character metrics. *) cms := NEW (REF ARRAY OF ScrnFont.CharMetric, m.lastChar - m.firstChar + 1); FOR i := 0 TO LAST (abcs^) DO ToCharMetric (abcs[i], m, cms[i]); END; (* Compute the meet and the join of the CharMetric bounding boxes *) m.minBounds := cms[0]; m.maxBounds := cms[0]; FOR i := 1 TO LAST (cms^) DO MinMaxMetric (cms[i], m.minBounds, m.maxBounds); END; (* Determine kerning and self-clearing property *) m.rightKerning := FALSE; m.leftKerning := FALSE; FOR i := 0 TO LAST(cms^) DO WITH bd = cms[i], bb = bd.boundingBox DO IF bd.printWidth >= 0 THEN m.rightKerning := m.rightKerning OR bb.east > bd.printWidth; m.leftKerning := m.leftKerning OR bb.west < 0; ELSE m.rightKerning := m.rightKerning OR bb.east > 0; m.leftKerning := m.leftKerning OR bb.west < bd.printWidth; END; END; END; m.selfClearing := NOT (m.rightKerning OR m.leftKerning); (* This is risky; we don't actually know anything about per-character ascent and descent ... *) (* Save the char metrics array if it contains any non-trivial data. *) IF m.minBounds = m.maxBounds THEN m.charMetrics := NIL; ELSE m.charMetrics := cms; END; m.fprint := Fingerprint.Zero; (* The fingerprint is used only by "JoinScreen.MungeBatch". I suspect that it is used only when two trestles watch the same VBT, in other words, in "Shared Trestle". If this is the case, there is no need for fingerprinting in Windows world. *) END; RETURN res; END LogFontToScrnFont;
EXCEPTION BadFontName; PROCEDURE*************************************************************************** Conversion Functions ***************************************************************************FanoutName (t: TEXT; VAR ts: ARRAY [1..15] OF TEXT) RAISES {BadFontName} = VAR start := 0; BEGIN FOR i := 1 TO 14 DO WITH pos = Text.FindChar (t, '-', start) DO IF pos = -1 THEN RAISE BadFontName; END; ts[i] := Text.Sub (t, start, pos - start); start := pos + 1; END; END; ts[15] := Text.Sub (t, start, Text.Length(t) - start); END FanoutName; PROCEDUREMatchingNames (a, b: TEXT): BOOLEAN RAISES {BadFontName} = (* This procedure is simplified. According to the Trestle specification, it should also deal with "?" patterns. *) PROCEDURE PatMatch (a, b: TEXT): BOOLEAN = BEGIN RETURN Text.Equal (a, "*") OR Text.Equal (b, "*") OR Text.Equal (a, b); END PatMatch; VAR as, bs : ARRAY [1..15] OF TEXT; BEGIN FanoutName (a, as); FanoutName (b, bs); FOR i := 1 TO 15 DO IF NOT PatMatch (as[i], bs[i]) THEN RETURN FALSE; END; END; RETURN TRUE; END MatchingNames;
PROCEDURE***************************************************************************ToFamily (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN WITH string = LOOPHOLE (ADR (lf.lfFaceName), Ctypes.char_star), text = M3toC.StoT (string), chars = NEW (REF ARRAY OF CHAR, Text.Length (text)) DO Text.SetChars (chars^, text); FOR i := FIRST (chars^) TO LAST (chars^) DO IF chars[i] = '-' THEN chars[i] := '_'; END; END; RETURN Text.FromChars (chars^); END; END ToFamily; TYPE FaceName = ARRAY [0 .. WinGDI.LF_FACESIZE - 1] OF Ctypes.char; PROCEDUREFromFamily (family: TEXT): FaceName = VAR res: FaceName; BEGIN WITH chars = NEW (REF ARRAY OF CHAR, Text.Length (family)) DO Text.SetChars (chars^, family); FOR i := FIRST (chars^) TO LAST (chars^) DO IF chars[i] = '_' THEN chars[i] := '-'; END; END; WITH text = Text.FromChars (chars^), len = Text.Length (text) DO FOR i := 0 TO MIN (len - 1, LAST(res)) DO res[i] := ORD (Text.GetChar (text, i)); END; FOR i := len TO LAST (res) DO res[i] := ORD (' '); END; END; END; RETURN res; END FromFamily; PROCEDUREToWeight (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN WITH w = lf.lfWeight DO IF w = 0 THEN RETURN "Unknown" ELSIF w < 150 THEN RETURN "Thin" ELSIF w < 250 THEN RETURN "ExtraLight" ELSIF w < 350 THEN RETURN "Light" ELSIF w < 450 THEN RETURN "Normal" ELSIF w < 550 THEN RETURN "Medium" ELSIF w < 650 THEN RETURN "SemiBold" ELSIF w < 750 THEN RETURN "Bold" ELSIF w < 850 THEN RETURN "ExtraBold" ELSE RETURN "Heavy" END; END; END ToWeight; PROCEDUREFromWeight (weight: TEXT): WinDef.LONG RAISES {BadFontName} = BEGIN IF Text.Equal (weight, "Unknown" ) THEN RETURN 0; ELSIF Text.Equal (weight, "Thin" ) THEN RETURN 100; ELSIF Text.Equal (weight, "ExtraLight") THEN RETURN 200; ELSIF Text.Equal (weight, "Light" ) THEN RETURN 300; ELSIF Text.Equal (weight, "Normal" ) THEN RETURN 400; ELSIF Text.Equal (weight, "Medium" ) THEN RETURN 500; ELSIF Text.Equal (weight, "SemiBold" ) THEN RETURN 600; ELSIF Text.Equal (weight, "Bold" ) THEN RETURN 700; ELSIF Text.Equal (weight, "ExtraBold" ) THEN RETURN 800; ELSIF Text.Equal (weight, "Heavy" ) THEN RETURN 900; ELSE RAISE BadFontName; END; END FromWeight; PROCEDUREToSlant (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN IF lf.lfItalic = True THEN RETURN "I"; ELSE RETURN "R"; END; END ToSlant; PROCEDUREFromSlant (slant: TEXT): WinDef.BYTE = BEGIN IF Text.Equal (slant, "I") THEN RETURN True ELSE RETURN False; END; END FromSlant; PROCEDUREToSpacing (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN IF Word.And (lf.lfPitchAndFamily, WinGDI.FIXED_PITCH) # 0 THEN RETURN "M"; ELSIF Word.And (lf.lfPitchAndFamily, WinGDI.VARIABLE_PITCH) # 0 THEN RETURN "P"; ELSE RETURN "*"; END; END ToSpacing; PROCEDUREFromSpacing (spacing: TEXT): WinDef.BYTE RAISES {BadFontName} = BEGIN IF Text.Equal (spacing, "M") THEN RETURN WinGDI.FIXED_PITCH + WinGDI.FF_DONTCARE; ELSIF Text.Equal (spacing, "P") THEN RETURN WinGDI.VARIABLE_PITCH + WinGDI.FF_DONTCARE; ELSIF Text.Equal (spacing, "*") THEN RETURN WinGDI.DEFAULT_PITCH + WinGDI.FF_DONTCARE; ELSE RAISE BadFontName; END; END FromSpacing; PROCEDUREToPointSize (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN IF TRUE THEN (* Simplification; need to check if lf is a TrueType font *) RETURN "*"; ELSE RETURN Fmt.Int (lf.lfHeight); END; END ToPointSize; PROCEDUREFromPointSize (pointSize: TEXT): WinDef.LONG RAISES {BadFontName} = BEGIN IF Text.Equal (pointSize, "*") THEN RETURN 0; ELSE TRY RETURN -ABS (Scan.Int (pointSize)); EXCEPT Lex.Error, FloatMode.Trap => RAISE BadFontName; END; END; END FromPointSize; PROCEDUREToEncoding (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN CASE lf.lfCharSet OF | WinGDI.ANSI_CHARSET => RETURN "ANSI"; | WinGDI.UNICODE_CHARSET => RETURN "UNICODE"; | WinGDI.SYMBOL_CHARSET => RETURN "SYMBOL"; | WinGDI.SHIFTJIS_CHARSET => RETURN "SHIFTJIS"; | WinGDI.HANGEUL_CHARSET => RETURN "HANGEUL"; | WinGDI.CHINESEBIG5_CHARSET => RETURN "CHINESEBIG5"; | WinGDI.OEM_CHARSET => RETURN "OEM"; ELSE RETURN "Unknown"; END; END ToEncoding; PROCEDUREFromEncoding (encoding: TEXT): WinDef.BYTE RAISES {BadFontName} = BEGIN IF Text.Equal (encoding, "ANSI") THEN RETURN WinGDI.ANSI_CHARSET ELSIF Text.Equal (encoding, "UNICODE") THEN RETURN WinGDI.UNICODE_CHARSET ELSIF Text.Equal (encoding, "SYMBOL") THEN RETURN WinGDI.SYMBOL_CHARSET ELSIF Text.Equal (encoding, "SHIFTJIS") THEN RETURN WinGDI.SHIFTJIS_CHARSET ELSIF Text.Equal (encoding, "HANGEUL") THEN RETURN WinGDI.HANGEUL_CHARSET ELSIF Text.Equal (encoding, "CHINESEBIG5") THEN RETURN WinGDI.CHINESEBIG5_CHARSET ELSIF Text.Equal (encoding, "OEM") THEN RETURN WinGDI.OEM_CHARSET ELSE RAISE BadFontName; END; END FromEncoding; PROCEDUREToWidth (READONLY lf: WinGDI.LOGFONT): TEXT = BEGIN IF lf.lfWidth = 0 THEN RETURN "*"; ELSE RETURN Fmt.Int (lf.lfWidth); END; END ToWidth; PROCEDUREFromWidth (width: TEXT): WinDef.LONG RAISES {BadFontName} = BEGIN IF Text.Equal (width, "*") THEN RETURN 0; ELSE TRY RETURN Scan.Int (width); EXCEPT Lex.Error, FloatMode.Trap => RAISE BadFontName; END; END; END FromWidth;
TYPE NullMetrics = ScrnFont.Metrics BRANDED OBJECT OVERRIDES intProp := NullIntProp; textProp := NullTextProp; END;----------------------------------------------------------------------------- The spec in ScrnFont.i3 states:
The method call m.intProp(nm)
returns the integer value of the
font attribute named nm
, or raises Failure
if this attribute is
not defined for m
. The method call m.intProp(nm, ORD(ch))
returns the integer value of the font attribute named nm
for the
character ch
, or raises Failure
if this attribute is not defined
for (m, ch)
. The textProp
method is similar.
The X implementation (XScrnFont.NullIntProp and XScrnFont.NullTextProp),
however, always raises Failure
. For now, we do the same ...
-----------------------------------------------------------------------------
PROCEDURENullIntProp (<*UNUSED*> self: NullMetrics; <*UNUSED*> name: TEXT; <*UNUSED*> ch : INTEGER): INTEGER RAISES {ScrnFont.Failure} = BEGIN RAISE ScrnFont.Failure END NullIntProp; PROCEDURENullTextProp (<*UNUSED*> self: NullMetrics; <*UNUSED*> name: TEXT; <*UNUSED*> ch : INTEGER): TEXT RAISES {ScrnFont.Failure} = BEGIN RAISE ScrnFont.Failure END NullTextProp; BEGIN DetermineFontNames(); END WinScrnFont.