freebsd-ports/lang/modula-3-lib/files/patch-am

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