mirror of
https://git.FreeBSD.org/ports.git
synced 2024-11-01 22:05:08 +00:00
97 lines
2.9 KiB
Plaintext
97 lines
2.9 KiB
Plaintext
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
|