Change the font lookup algorithm to prefer non-scalable fonts when they are available. The original algorithm came up with some really ugly scaled fonts sometimes, even when an equally suitable unscaled alternative was available. =================================================================== RCS file: /home/jdp/m3-cvs/m3/ui/src/xvbt/XScrnFont.m3,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 XScrnFont.m3 --- m3/ui/src/xvbt/XScrnFont.m3.orig 1996/09/24 05:22:01 1.1.1.1 +++ m3/ui/src/xvbt/XScrnFont.m3 1996/09/24 05:32:38 @@ -193,12 +193,16 @@ PROCEDURE FontLookup (orc: FontOracle; name: TEXT): ScrnFont.T RAISES {ScrnFont.Failure, TrestleComm.Failure} = - VAR s: Ctypes.char_star; + VAR + s: Ctypes.char_star; + uname: TEXT; BEGIN TRY TrestleOnX.Enter(orc.st.trsl); TRY - s := M3toC.TtoS(name); + uname := FindUnscaled(orc.st.trsl.dpy, name); (* Prefer unscaled font *) + IF uname = NIL THEN uname := name END; + s := M3toC.TtoS(uname); VAR xfs := X.XLoadQueryFont(orc.st.trsl.dpy, s); BEGIN IF xfs = NIL THEN RAISE ScrnFont.Failure END; @@ -209,6 +213,65 @@ END; EXCEPT X.Error => RAISE TrestleComm.Failure END; END FontLookup; + +PROCEDURE FindUnscaled(dpy: X.DisplayStar; pat: TEXT): TEXT RAISES {X.Error} = + (* Return the first matching unscaled font, if any. Otherwise return NIL. *) + VAR + s := M3toC.TtoS(pat); + xcount: Ctypes.int; + fonts := X.XListFonts(dpy, s, 32767, ADR(xcount)); + fp := fonts; + count: INTEGER := xcount; + xmatch: Ctypes.char_star := NIL; + match: TEXT := NIL; + BEGIN + IF count = 0 THEN + IF fonts # NIL THEN X.XFreeFontNames(fonts) END; + RETURN NIL; + END; + + FOR i := 0 TO count - 1 DO (* Search for an unscaled font *) + IF NOT IsScaled(M3toC.StoT(fp^)) THEN + xmatch := fp^; + EXIT; + END; + fp := fp + ADRSIZE(fp^); + END; + + IF xmatch # NIL THEN (* Found an unscaled font *) + match := M3toC.CopyStoT(xmatch); + END; + X.XFreeFontNames(fonts); + RETURN match; + END FindUnscaled; + +PROCEDURE IsScaled(name: TEXT): BOOLEAN = + (* Return true if font is scaled. *) + VAR + len := Text.Length(name); + fieldNum := 0; + found0 := FALSE; + hyphenPos: INTEGER; + BEGIN + (* A font is scaled if: + a. it is in canonical form (starts with '-', and all 14 XLFD fields + are present), and + b. any of the fields pixel size, point size, or average width is 0. *) + hyphenPos := Text.FindChar(name, '-', 0); + WHILE hyphenPos # -1 DO + INC(fieldNum); + IF fieldNum = 7 OR fieldNum = 8 OR fieldNum = 12 THEN + IF hyphenPos+2 < len AND + Text.GetChar(name, hyphenPos+1) = '0' AND + Text.GetChar(name, hyphenPos+2) = '-' THEN + found0 := TRUE; + END; + END; + hyphenPos := Text.FindChar(name, '-', hyphenPos+1); + END; + + RETURN fieldNum = 14 AND Text.GetChar(name, 0) = '-' AND found0; + END IsScaled; CONST BuiltInNames = ARRAY OF