freebsd-ports/lang/modula-3-lib/files/patch-am
John Polstra d5a92ea924 Split the Modula-3 port into two pieces, creating a new port
"modula-3-lib".  It installs only the shared libraries needed for
executing Modula-3 programs.  This saves a lot of disk space for
people who need to run Modula-3 programs but don't need to build
them.  The original "modula-3" port now depends on this one, and
uses it to install the compiler and the rest of the development
system.

Also, everything is now built with optimization.  I have been
testing this for at least a month, and haven't seen any problems
from it.  It makes the libraries and executables substantially
smaller.

This new port also includes some hooks that will make SOCKS support
possible in the near future.
1996-10-29 23:01:55 +00:00

98 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.
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