1 files changed, 97 insertions, 0 deletions
diff --git a/lang/modula-3-lib/files/patch-am b/lang/modula-3-lib/files/patch-am
new file mode 100644
index 000000000000..57085c2bc1b2
--- /dev/null
+++ b/lang/modula-3-lib/files/patch-am
@@ -0,0 +1,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