1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
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.
Index: m3/ui/src/xvbt/XScrnFont.m3
===================================================================
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
--- XScrnFont.m3 1996/09/24 05:22:01 1.1.1.1
+++ 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
|
