From ea087f7a4e6cd92e3ddf2344491f796aada6512a Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Fri, 8 Aug 2025 22:18:44 -0700 Subject: [PATCH 1/9] Verbose mode implemented incorrectly --- lispusers/READ-BDF | 34 ++++++++++++++++++---------------- lispusers/READ-BDF.DFASL | Bin 20898 -> 20923 bytes 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 229d59d0e..ebc2174c4 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,13 +5,14 @@ BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) -(IL:FILECREATED "30-Apr-2025 13:20:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;61| 47500 +(IL:FILECREATED " 7-Aug-2025 18:06:58" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;2| 47764 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME) + :CHANGES-TO (IL:FUNCTIONS READ-BDF WRITE-BDF-TO-DISPLAYFONT-FILES BDF-TO-CHARSETINFO READ-GLYPH + GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME) - :PREVIOUS-DATE "25-Apr-2025 10:10:08" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;60| + :PREVIOUS-DATE "30-Apr-2025 13:20:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;1| ) @@ -488,7 +489,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST X)) Y)))) -(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") +(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") + (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") (LET @@ -603,15 +605,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETF (BF-SLUG FONT) GL)))))) (ENDFONT (SETQ FONT-COMPLETE T)))))))) - (WHEN VERBOSE - (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) - SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) + (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) + SIZE) + (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) + (WHEN VERBOSE (FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" (BF-NAME FONT) - FAMILY SIZE WEIGHT SLANT EXPANSION))) - FONT))) + FAMILY SIZE WEIGHT SLANT EXPANSION)) + (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE))))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") @@ -823,10 +825,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2316 10275 (BDF-TO-CHARSETINFO 2316 . 10275)) (10277 16147 (BDF-TO-FONTDESCRIPTOR -10277 . 16147)) (16149 19687 (GET-FAMILY-FACE-SIZE-FROM-NAME 16149 . 19687)) (19689 26500 ( -GLYPHS-BY-CHARSET 19689 . 26500)) (26502 27927 (PACKFILENAME.STRING 26502 . 27927)) (27929 34733 ( -READ-BDF 27929 . 34733)) (34735 35058 (READ-DELIMITED-LIST-FROM-STRING 34735 . 35058)) (35060 41548 ( -READ-GLYPH 35060 . 41548)) (41550 42291 (SPLIT-FONT-NAME 41550 . 42291)) (42293 46075 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 42293 . 46075))))) + (IL:FILEMAP (NIL (2425 10384 (BDF-TO-CHARSETINFO 2425 . 10384)) (10386 16256 (BDF-TO-FONTDESCRIPTOR +10386 . 16256)) (16258 19796 (GET-FAMILY-FACE-SIZE-FROM-NAME 16258 . 19796)) (19798 26609 ( +GLYPHS-BY-CHARSET 19798 . 26609)) (26611 28036 (PACKFILENAME.STRING 26611 . 28036)) (28038 34997 ( +READ-BDF 28038 . 34997)) (34999 35322 (READ-DELIMITED-LIST-FROM-STRING 34999 . 35322)) (35324 41812 ( +READ-GLYPH 35324 . 41812)) (41814 42555 (SPLIT-FONT-NAME 41814 . 42555)) (42557 46339 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 42557 . 46339))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 1974ed35938ba59ce1aee8f097126b0f96dea634..3c3b384320b0b40c450b420b825eeb204cd0a3f6 100644 GIT binary patch delta 483 zcmZ3qm~r=F#tAWTMqI)9rA5i93Tc@+sS3$Osfi`2DGCbax{jskx<&>@rV54@Rt9EP zrWRaoj=?^t%0eskfU|oSIk|KTTfl z<{$hSWbPcW_!JPc7or5j>;N;r)Pku`F(8WJPZ*f@!39DYK_~?X#Rs7_d%E9ZV*I>W P#p^3G2;1Hk~^M9Zio11@-uOpayaB{WPUhWxFd)Q-q!$4{#+gVHVfApLQ zRLjuk45Ao6PR_7aW&F6g&svL_n=3fL$J5zW*U-{*^AWqxOpG5U?{LhLf(aWL7&A+Q zb-m#MQ=d26IyJEX%{buZ&-iJwfV-&eXOP()VA(IV5F27Z6vLk|Fz>w!gffCq3J{79 ZLTyfRzs1D(X|t`@S7ye~n~nWCm;oW%hK2wD From 3410e3db62aa8c40da37a18ee797bcc4b4aaa7ea Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Fri, 7 Nov 2025 21:47:39 -0800 Subject: [PATCH 2/9] Cleanup DEFPACKAGE using :IMPORT-FROM, and fewer imports. Various renaming for consistency with XCCS -> MCCS changes. Use IL:FONTSPEC record instead of using FIRST, SECOND, etc. Fix the parsing of IL:FONTSPEC to use COMPRESSED instead of incorrect CONDENSED. Zero-width "image" with zero-width "escapement" GLYPHS get put into NOMAPPINGCHARSET. Add (FILES (SYSLOAD) SYSEDIT) under existing (DECLARE: EVAL@COMPILE DONTCOPY ...) --- lispusers/READ-BDF | 183 ++++++++++++++++++++++----------------- lispusers/READ-BDF.DFASL | Bin 20923 -> 21485 bytes lispusers/READ-BDF.TEDIT | Bin 9640 -> 9819 bytes 3 files changed, 103 insertions(+), 80 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index ebc2174c4..a4c28123e 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,18 +1,19 @@ (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT \AVGCHARWIDTH \FGETWIDTH \FONTFACE \FONTFILENAME -\FSETOFFSET \FSETWIDTH \FONTSYMBOL \GETSTREAM \INSTALLCHARSETINFO \PUTBASE BITBLT BITMAPCREATE -BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP -FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) -READTABLE "XCL" BASE 10) +"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" +"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" +"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" +"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10) -(IL:FILECREATED " 7-Aug-2025 18:06:58" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;2| 47764 +(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS READ-BDF WRITE-BDF-TO-DISPLAYFONT-FILES BDF-TO-CHARSETINFO READ-GLYPH - GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH + WRITE-BDF-TO-DISPLAYFONT-FILES) + (FILE-ENVIRONMENTS "READ-BDF") + (IL:VARS IL:READ-BDFCOMS) - :PREVIOUS-DATE "30-Apr-2025 13:20:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;1| + :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| ) @@ -24,8 +25,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) - (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP) - IL:FONT)) + (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) + IL:SYSEDIT) + (IL:FILES (IL:LOADCOMP) + IL:FONT)) (FILE-ENVIRONMENTS "READ-BDF") (IL:PROP (IL:DATABASE) IL:READ-BDF))) @@ -41,10 +44,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SLUG NIL :TYPE GLYPH)) (DEFSTRUCT GLYPH - "This is an individual BDF glyph. Includes some values calculted for creating CHARSETINFO" + "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" (NAME NIL :TYPE STRING) ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP - (XCODE 0 :TYPE INTEGER) + (MCODE 0 :TYPE INTEGER) (WIDTH 0 :TYPE INTEGER) (ASCENT 0 :TYPE INTEGER) (DESCENT 0 :TYPE INTEGER)) @@ -56,6 +59,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) (DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") @@ -99,7 +103,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST ((INTEGERP SLUG-OR-WIDTH) (SETQ SLUGWIDTH SLUG-OR-WIDTH)) (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH))) - (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((XCODE (CAR XGL)) + (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL)) (GL (CDR XGL)) (GWIDTH (GLYPH-WIDTH GL)) @@ -113,13 +117,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST    "Is the above statement actually true?") - (SETF (GLYPH-XCODE GL) - XCODE) + (SETF (GLYPH-MCODE GL) + MCODE) (SETQ FIRSTCHAR - (MIN FIRSTCHAR XCODE + (MIN FIRSTCHAR MCODE )) (SETQ LASTCHAR - (MAX LASTCHAR XCODE) + (MAX LASTCHAR MCODE) ) (INCF TOTAL-WIDTH GWIDTH) (SETQ ASCENT @@ -134,13 +138,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:* IL:|;;|  "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I TOTAL-WIDTH)) (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I SLUGWIDTH)) (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) @@ -152,19 +156,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH) HEIGHT 1)) (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) - (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH XCODE :DO (SETQ GLBM + (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM (GLYPH-BITMAP GL)) (SETQ GLW (GLYPH-WIDTH GL)) - (SETQ XCODE (GLYPH-XCODE GL)) + (SETQ MCODE (GLYPH-MCODE GL)) (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) (+ DESCENT (GLYPH-BBYOFF0 GL)) (BITMAPWIDTH GLBM) (BITMAPHEIGHT GLBM) 'INPUT 'IL:REPLACE) - (\\FSETOFFSET OFFSETS XCODE DLEFT) - (\\FSETOFFSET WIDTHS XCODE GLW) + (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) + (IL:\\FSETOFFSET WIDTHS MCODE GLW) (INCF DLEFT GLW)) (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") @@ -186,6 +190,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") (WHEN (AND (BDF-FONT-P BDFONT) @@ -201,18 +206,22 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE)) MAP-UNKNOWN-TO-PRIVATE))) (WHEN (LISTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY) - (OR (SECOND FAMILY) + + (IL:* IL:|;;| "Assume this is a FONTSPEC") + + (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC IL:FSFAMILY) + IL:|of| FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) IL:|of| FAMILY) SIZE) - (OR (THIRD FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSFACE) IL:|of| FAMILY) FACE "MRR") - (OR (FOURTH FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSROTATION) IL:|of| FAMILY) ROTATION 0) - (OR (FIFTH FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) IL:|of| FAMILY) DEVICE 'DISPLAY) MAP-UNKNOWN-TO-PRIVATE))) - (SETQ FAMILY (\\FONTSYMBOL FAMILY)) + (SETQ FAMILY (IL:\\FONTSYMBOL FAMILY)) (UNLESS (AND (INTEGERP SIZE) (PLUSP SIZE)) (ERROR "Invalid SIZE: ~S~%" SIZE)) @@ -237,7 +246,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (INTERN (STRING-UPCASE DEVICE) "IL")) (T (IL:\\ILLEGAL.ARG DEVICE)))) - (SETQ FACE (\\FONTFACE FACE NIL DEV)) + (SETQ FACE (IL:\\FONTFACE FACE NIL DEV)) (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) (UNLESS SLUGWIDTH @@ -269,15 +278,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST GBCS CSET (OR SLUG (1+ SLUGWIDTH )))) - (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) + (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET + ) (LIST CSET))))) (LIST FONTDESC CHARSETS)))) (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) FAMILY) (GBCS-TO-FONTDESC (SECOND GBCSL) - (\\FONTSYMBOL (CONCATENATE 'STRING - (SYMBOL-NAME FAMILY) - "-UNMAPPED"))) + (IL:\\FONTSYMBOL (CONCATENATE 'STRING + (SYMBOL-NAME FAMILY) + "-UNMAPPED"))) (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) :TEST #'EQL))))))))) @@ -312,8 +322,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST '((#\R . REGULAR) (#\N . REGULAR) (#\B . BOLD) - (#\S . CONDENSED) - (#\C . CONDENSED))))) + (#\S . COMPRESSED) + (#\C . COMPRESSED))))) 'REGULAR)) (IL:* IL:\;  "S is for \"SemiCondensed\", Assuming \"Condensed\"") @@ -337,17 +347,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (FIRST (BF-SIZE BDFONT)))))) (DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") + (IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth") (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") (LET* ((NCSETS (+ MAXCHARSET 2)) (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) - (UTOXFN (COND + (UTOMFN (COND (RAW-UNICODE-MAPPING #'IDENTITY) - (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE) - (T #'UTOXCODE?))) + (MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE) + (T #'UTOMCODE?))) (SLUG (BF-SLUG FONT)) (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - NOMAPPINGCSETS ENC XCODE XCS) + NOMAPPINGCSETS ENC MCODE MCS) (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL))))) @@ -359,7 +371,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST :UNLESS (EQ GL SLUG) :DO - (SETQ XCS NIL) + (SETQ MCS NIL) (SETQ ENC (GLYPH-ENCODING GL)) (WHEN (LISTP ENC) @@ -373,9 +385,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST  "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it") ) - (SETQ XCODE (AND (INTEGERP ENC) + (SETQ MCODE (AND (INTEGERP ENC) (PLUSP ENC) - (FUNCALL UTOXFN ENC))) + (FUNCALL UTOMFN ENC))) (IF RAW-UNICODE-MAPPING (COND ((> ENC 65535) @@ -395,7 +407,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (CONS ENC GL))) (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) (COND - ((NULL XCODE) + ((AND (ZEROP (GLYPH-BBW GL)) + (ZEROP (FIRST (GLYPH-DWIDTH GL)))) + + (IL:* IL:|;;| + "This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET") + + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + ((NULL MCODE) (IL:* IL:|;;| "These assoc with the Unicode encoding") @@ -409,37 +429,37 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (TCONC (AREF CSETS NOMAPPINGCHARSET) (CONS ENC GL))) (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) - ((AND (INTEGERP XCODE) - (<= 0 XCODE 65535)) + ((AND (INTEGERP MCODE) + (<= 0 MCODE 65535)) (IL:* IL:|;;|  "These assoc with the 8 bit character code within the charset") - (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS) + (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) (IL:* IL:|;;| "Default SLUG width is width of A.") (WHEN (AND (NOT SLUGWIDTH) (= ENC (CHAR-CODE #\A))) - (IL:* IL:|;;| "A is the same code in XCCS and UNICODE ") + (IL:* IL:|;;| "A is the same code in MCCS and UNICODE ") (IL:* IL:|;;| - "Comparing with ENC, not XCODE, to look only in charset 0") + "Comparing with ENC, not MCODE, to look only in charset 0") (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) - ((LISTP XCODE) + ((LISTP MCODE) (IL:* IL:|;;|  "These assoc with the 8 bit character code within the charset (like above)") - (LOOP :FOR XC :IN XCODE :WITH CS :UNLESS (MEMBER (SETQ CS - (LRSH XC 8)) - XCS) + (LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS + (LRSH MC 8)) + MCS) :DO - (PUSH CS XCS) - (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS))) - (T (ERROR "Invalid XCODE: ~A~%")))))) + (PUSH CS MCS) + (PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS))) + (T (ERROR "Invalid MCODE: ~A~%")))))) (IL:* IL:|;;| "Extract the lists from the TCONC pointers") @@ -701,7 +721,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) (SETQ BYTEPOS (* 16 (1- NWORDS))) (LOOP :REPEAT NWORDS :DO - (\\PUTBASE BM.BASE WORDINDEX + (IL:\\PUTBASE BM.BASE WORDINDEX (LDB (BYTE 16 BYTEPOS) BITS)) (INCF WORDINDEX) @@ -746,12 +766,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (CHAR-SETS T) MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth") (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) + (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) (COND ((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets") ) @@ -771,7 +792,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) (SETQ FAMILY (OR FAMILY FN-FAMILY)) (WHEN RAW-UNICODE-MAPPING - (SETQ FAMILY (\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) + (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) (SETQ FACE (OR FACE FN-FACE)) (SETQ SIZE (OR SIZE FN-SIZE)) (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) @@ -782,16 +803,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (\\FONTFILENAME FAMILY SIZE FACE + (IL:\\FONTFILENAME FAMILY SIZE FACE "DISPLAYFONT" CS)))) (IF WRITE-UNMAPPED (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE UNMAPPED-FONTDESC CS (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (\\FONTFILENAME (FONTPROP - UNMAPPED-FONTDESC - 'IL:FAMILY) + (IL:\\FONTFILENAME (FONTPROP + UNMAPPED-FONTDESC + 'IL:FAMILY) SIZE FACE "DISPLAYFONT" CS)))) (SETQ UNICODE-CSETS NIL)) @@ -803,6 +824,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY +(IL:FILESLOAD (IL:SYSLOAD) + IL:SYSEDIT) + + (IL:FILESLOAD (IL:LOADCOMP) IL:FONT) ) @@ -810,25 +835,23 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") (:EXPORT "READ-BDF" "WRITE-BDF-TO-DISPLAYFONT-FILES") - (:IMPORT \\AVGCHARWIDTH \\FGETWIDTH \\FONTFACE - \\FONTFILENAME \\FSETOFFSET \\FSETWIDTH - \\FONTSYMBOL \\GETSTREAM - \\INSTALLCHARSETINFO \\PUTBASE BITBLT - BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH - BLACKSHADE BLTSHADE BOLD CONDENSED - CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP - FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM - REGULAR TCONC UTOXCODE UTOXCODE? - WRITESTRIKEFONTFILE)) + (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" + "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" + "BLTSHADE" "BOLD" "COMPRESSED" + "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" + "FONTP" "FONTPROP" "INPUT" "ITALIC" + "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" + "UTOMCODE" "UTOMCODE?" + "WRITESTRIKEFONTFILE")) :READTABLE "XCL" :COMPILER :COMPILE-FILE) (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2425 10384 (BDF-TO-CHARSETINFO 2425 . 10384)) (10386 16256 (BDF-TO-FONTDESCRIPTOR -10386 . 16256)) (16258 19796 (GET-FAMILY-FACE-SIZE-FROM-NAME 16258 . 19796)) (19798 26609 ( -GLYPHS-BY-CHARSET 19798 . 26609)) (26611 28036 (PACKFILENAME.STRING 26611 . 28036)) (28038 34997 ( -READ-BDF 28038 . 34997)) (34999 35322 (READ-DELIMITED-LIST-FROM-STRING 34999 . 35322)) (35324 41812 ( -READ-GLYPH 35324 . 41812)) (41814 42555 (SPLIT-FONT-NAME 41814 . 42555)) (42557 46339 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 42557 . 46339))))) + (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR +10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 ( +GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 ( +READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 ( +READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 3c3b384320b0b40c450b420b825eeb204cd0a3f6..927778eaf9838aafa5ba0d1b7cc9d57d42e6156d 100644 GIT binary patch delta 7890 zcmcgxd3aRUb$|EGXe1;g4O##RFoPv_#vlohk%TpGW}c)cX66m^o+OmYmc^2QgN+LY zF9E*+J8rPYVz~y-v!#L;NVBvyk)70T`w_bhHa5mAZOqqxuI@VGZ-<`sqp}!N<5TM6;sV7J5;T`19FQ* zZjTl=JJPAbU_=S6FglblFblxkf$pFl2}5>BkH!QZR3cgk6cOQ%JCZQK5l>VN zYhBQm{Dj)x6;ZGhGo;6WSI1py!)evDqd!#qsVfcf+{;W0F zmGip#ic&100D3prbJbszLi(w2G{fWZ}XZa z=Nr97L|4M;11W^i0cM)J>>fVH({p`GQJS;#V{$rG@n!SpK&p{HeqvvYRD|J1I!M%rl$FLEIuG%eQ{ljnQDR*vb~L@+mRlu z_CU%FGsVcKoB}7O(2?UES>i}9Ny`qDIf@ELPPDg8f_m+3_?zakeIFDx_7`fH3~tMD z!wx_v7Dts8Dt0XO8}uW1y+7p^{fEfVz5+c7s3@p+#lkSYL46e|tiq^jCbSStR~T$y z6vkohsR>h44N7|qn)U*Rb2wk<>nI~%WH^cLZs%qWkT6vT2Hk*;Bo%fzY2OR^B~ZfH&T(juN@nn!|W3+l*ZeP}c*FH`(!YXa|zEBA5>X1IIy( zG7l9kWq-l%E1Kc@yB6%fp{0V@}cHwG;zm!KTI*G}4fS)d!$8P7J7Y%p= z<7pL2(hwQ#9=UD&Fk`!ULCK3&E4KeK>Hh`c2L%5a;cEoXBm8TE=MZv&XYVC(rk}*y zDv8sLB;J}y;#4__H^qE>BUAejGy==n75H0d3U4Xh#fJFt(uTqd<#wRh4!FVflIrWg z^(o%^aRF9DrMwK0W;Wm94O+|Q+J8RY-t1XsZ&_^Lwa`{-?5$Kc4TYUd?B-s|dKfYa)EMkNusH2j((SQ#SPILY(zlH#+yr6 zA2k7k4LS8Bs9+P1_xhctQSgBg$^;)`4U0+tA4nGVW8=^7G7Icyz$j_AaBuYI`Xy5u zg#nyb9|3K=DCkS00djtx<76YT<5e~$`~o<|*Onu~f+c!A1CrB; z*_k3ZmULBwo+D!1ehthb;dW*oIfadm;r%AZ%S6%It;3pGEoDfs_HP<8?f(QnoOqjbg^3%#9x&6{KN!~RIKTePqW+%z`4LD2ZRyfx4 zHtEmM=UMtZN1x~UoXPbp%KvO~69sH$pqe$|heB`}!i5CUV>XRoBSII!r2wU05L|+g zs$z=~zDU{zgijKzN4OKAbpC53&P7R_ZM17pdqza~w<*H2y0Hj_gY(pScAh=&Y>zWQ_BHX<%i>~|t`cTAtHiy4kJ%`_4-BuN5c9>Pd5e|mD z01oDcsX%DD(+&e;<<$0ks-ihvKQz6|Iu3`^>|F)=!u1p=oa+xJ_d(LR z1c_S@Djx>rwRa!X%_0~35Kbg`Gs04Ww*Zu1z;l-x3&$~mC19~u_HqSUb~my65%vQ+ zPfaBB1f--BSYe+MiRhsq{I5XW5hAZ%Lt?%4KiIXfdSlp;7%1%F)b#-8iWTS zOWdF!Wx3#(g4zv2^a|mlqKH0);9BJ5QKtNf5dSK~X(3(};xTm8x#i&14$R~&RKhxh z?Kw#6j#;FpRm2F=tRcvLL`Aai32{gWF2rIXCJW&qA^ky!Z-NhHZr3$l;EB2>0%sBM zfx#uSO1op*z{U-0eFk4Uqmy-xJU63FW}W-NJ?Z>$OuVx1z@ru|a)!?J|0! zaFOMMwaw)bEayeY8Amy7(8>I4t!aG&^-HOZ0|@D?!?q!G+npe!XN4FB+w6rF^@C(& zeM5-#LUaky4rFl)E&{47R_8Dl`YhyRuFjAykgkx$PJZ9a)_i5U9hd-zuOH96by5lq zr-^mJ3fI51{^h{a$D}K~an|iFdE+QQI_q@FMY7EU;N)_z{H`a5gwm^U18*LCorDl_sl;({*dlv{bik>?LWpI;XMn!8e%n3y{u!SYZFu~ zt@j^4#>#Hf%RHDmSu*;AifqEuUvXToV57i~K8ZL*5bfAW5mUv6!1_c?{h1Jd4{P+wqA9A1CeNT3aENeO#*p zp9-`vTro7W*G)ygA!9Z3(y8)H?2Yn{x}fI_s&D0c>zdghKUH^qGrI69^d4DJuIP_< zvI>Y4NV-NL7Q#DxX1xzy@!IMyunT;8gJ$7KiMuX)7vWJd#JM5uA-EmkHxWw1ok9~3 zsRnEUbas!P2*+zFtACOZ?j6|WE4y@4-9Vc6nuK7`2jy{i18vhF_$g7|QeVJ7ZP)-W zYQ2l+6h+0_h-_%^~l_d>R((Vun zS>o%PYb{x-ppjIEx562W*uC1s^iHuH~0xsB9u&AE`jlw6q zhGF^`soCeCE`{SG`XdkGmlf*N?U1R=dgnnw}7A~Zh)XGK_Q9T{o)4ePxq z108ACbU(hkhE(YOB{vqJ?O#$ph6Cv#g4?%K!NXsn)ctKJWH+s4*9E$ORVM}1S-mFaE=xB z#mz)VS8PSy(ji;t1T2e#h z%e6yxeB`;{eiw`LU|XMsCkI)?(jkNt6y*sBX~UN#gn87gCjqiw=OA6N*sY+IKC|)A z>0FIym?%(4cwmxVClk`r9FrMphfr%VtW|oH7?%-#3!yCUAR&?O(xq<7zbd-*YQ0GL zgb=5ht2cmI<~)6~STvdtAt7c7;S-`lh#TO(iH71VE8{}KWr!yfvBEy4e0desb(o)M zpKS%ffQjXE1>y5VVb2J0KnQq~!aRI6g_k6F-Nw{rp}Y+XlV~vtPgxgfXfbvOjtGdf z7#oCUK5_Qq+ZDS`s3ww%R-;53=@MyvhvlCYnwP+XaTFV}jgr2PEP0x42SlJczuXQq zlI6Mic3>uE1 z{hnK>8fIcpkL!kJ!m1OS#vwmuv0-X}92GZ_LwV#4J0gbp=uNQm=8@-O-X9S+)T6E& z2mP}K{cO+=b0|TltC7Q|O(D1;S&{n7z zXK}y4exTUF-bbhatytVH#AZSSG2bjCh{@KE&eKAW`w;$$T7xC9kEqQzBRo!8;(nhO z$Eut0LdrIh7N9^X5A=NnzTx7yz}sZEme6AuF`3=M;HxyZUB_RKud=G_iGSknOUHa&YW?ZI hFLk~y6%)Ah3p1FnTNy5EvDZQG$uV7`cs@Kj`ae9WWEB7a delta 7224 zcmai34Rlk-m45Ri%d%x-WBh~pvkW#i27xXAfeiuuJX=pldb0FnZ0e*yx*I}C(ga9o zX^^0$Bwfc424hV^lPyWQNzd-KsY~-q)1TARZkiLw4}|WXw#n|6rfp~lX_Cze348CI zC;#*`yT{_)J9oahbLY;?H}f7B|A{^G5Ia1?y!T#LIjhs-+jWD-+w5(3x2)`H?&xY? zdGEpbRh@1y@7l4`jWx@ts>CsNaZCCAdwR ziL~a6LUGoR9!r|ONCf+aR(h<*0JC!_o-+NuBzkxFb<-a~$3>t;eepm-^O;yysg05W!CHk<;ydBOM8Xu^?c?f?6!8VZk*$hWwzOj7NNfP%{IE z5Y&=^gdR7I1X%LW5(mXeO2R-rPme*^pg43Gk{&=)#EQ)xNhC3^j;I#YQ_<}5(c%1r z)|-m>$ejs+Al{iWje&qc5f|k2wb@agXZv#~l;w876!iNNy3ZfclG!7}g;C#t6}JdM z*#%`Yq{q-khSHb;Ig9HtnqEk;2=Q)v!#o66_=7zj)9_3m9su^*7p+CW%-+agJe2hK z2R&0enH7h`_E-yGIm{+_r_P)(H9-$}1s|{5>l)EVA=$_gVM-vYx=DR{Z~>u_|Ax8q zK;d@Ym)FG~%j;XHxw4#PkE+?>a`)d@-lM}Ee4eA7d3n;Yo%#8X96QqbqU@pJQV1s% zFjEQ5WB9{bz$_Cw6S{3)mKSBYP3Q`wFh6eSF;h#BK^1#Q+AZn8UPp)Ru$q$jRO7U2 z3N2Y=$r+X`C7Bj_nPn)qWTn_s1^tRW_?P9XNQ0~Cf6&8h2wROOg$~&&j{4SXm_bSq zrlbh0_FSTd?MZzjr3_ZPk%|Q&^L}H15}PiJYA_XnBuz4AJ`U?rOPIQrB!DAHTSMx> zNj+cMTc{#mR#=7pe#oF9SCT_62141BkrYn(p{k?J z1VhM;#1n@lamKkK9m*&fnhFPj4rRcHLoT6=_%bxf2N%|Gxx^esj6I?!&5XFyLRe|A z5cg)t*&`XT7wTt#hv~_&U`Lc}n%lrxKF)rxmQYmLa38cPhE~%OXf@&!zHw0dE#$P+ zTF9fBeG>Z>02P3{iF{jt(agTIM10jkOw59XIF@s9004y(E^sz1#8?jTH48C0Ult;p zLmadalat6D0ZNpZHm19*U?%3*a&%utgeCB9K;XQ{S?Av=>|n$ELSe(K2eZc%=enOl zVw6&aTtCR&u4<<9H_DsXZT#0IyMgn-e{{&i16 z*!8=X~0fZTp_}X#FxrMn29hlOexYuSdqIwY!OS?B9^ejvRiZ#w&)~m(Mi~%ldz-{5w_SQ zY_Ulg*d$FI%(fiOvE)2UE+D#r=KuE}QVtF49udYRLX?vuXkJQHhoHi##o#C+ZYSGO zu|Ex|8>PZAdXCXE3t*eyzk#R$ln^QTe*XYm3Yv3;!HEJM>2N4fMIIe@Qk|qEhc6k> zVsKXB!o!o73bOy>86X--MiX3f1#vV4BpM3pAHh@@FyezAYiL9~Fhe=wA=C-E!2gI~ z*?v0re4N`%e*(me-ZY+vp2@uAyiIKVw*Xco9sP~nFFU(9iTTw1|7XAyPxT`yAT6_= z3+nAj)Th(HrAg3KCLm9r}PW3EfC9r z{xTJmTM-sW&4Jznkd?%Vl_D`|W|K7YZJEmV0qK%q=hl(s%svhG!6YuX$ShpmG~EA8 z_B^oyEuaH|wTfc({2?H%37S}+ur3F9uzWS&S6*BHk&N&snM_79A1nN8vSfusmSG^v z<*VO>t)&PXoSqrmJer*6XOj4(T(B?LssvC4QcaG`u1GRtpYY$ft{K0(;%AIq;YL+O z%Zt?TG+gl~_b{^Ft7Jb*&vW#Ajh^TEXqA@@@LyDQ5hb%En%P=>_(;75)fJ?!L3KW< zt5LO)+6}7m2U5FGJx%H=R8Nw+64m=j?L>7Ss>=BrNW2y$ajsJ=LhD({;ja>hvySN; z&RqQA*^j|9Rz0`uKkaqo(mzXtiv>_^80dT9;wi~wlF)vq$~0bp{7F`49v+_4$p2K` zQypa@$|~T329xT9t2n%p0Qu|^Q9$&~i{w)mQME+G82k`OmY9g~C+2KuoB)&xgTb$I z5@5jGC*(BQp5YyHcU1LmdwSb5+n&Ao>eW-Xz)+PRZo+5H`02S`8%uDtCYAoKSPWUP z9TBxC_ES!5dqf?Us-!Vr8Wl3CkKhGKiv{C=Q1^(1AlOz4aTBU>sLs<82_pd|2!Yx_Lg-+P;lf=7a`sLjeuT!&G-Yst3h#6t{{n zij7i)rJ&`@2v$Te^?j;Pe=Ef=rFc$?aVZXnC24S_eoibwu~Ld+DO3{d11TP*7VNkb zho$(c6!lURkWfC5;-VA>U^r!V+mzQmyuU7r!08WNvM}$h?PtmH2Wop%mgK)%q_H8s zv@Y!2fdN&D`TXm3-Odz3Pl{@OzRpbDfrSp4F;raw^TzBV2|{^Tif;%HmPUkUkML|2 zo|N$Pie)aasd9mzz%~zyCPaNKn)rDA+Wc^h&}YJ(fo7@Ow?Xp)r$?M|r%d(m8q)6-N2ZO|_*PXUIX9AZi@qe6Xn| zoyCGKT2ZVM4JcZuqK}j*E5#lMa{EmRjo)@L-#f!LpF?R8%|*oKFeT1GVU0v zZb}NNl>nKU(4t1a<_V_YbvghaL~yCu_6#0YRJS(Bs_3$q^} zV#`E7YK>?E3#0ov+l=ausgg)#t*mUua5wl8F{oBvkkx#3%i{D{P&$&^Vr&VOo}5GC zsd7NunxLsI;KOxbtA`o3t=9%op9^+|M~kfpv^=dZ<%?iR((wJD0>{CVJ&o$^q&|b{ zc2b{3^;)_qu~VoIkQv*tQON)oq{6p`;&Nk?d+G7p7Ks@52LqYjU?hTZd3bKBBE%;9otW>wlwoQ&lI5i?DH!bA zsULm#?DkvXqs!OZ8(sZ$tg`2s=;x=}=fK)O-~N4g-qQgKeEeG-|7x$<_p2+2wL7y;lHZu;VwUIZ$bPo2JaFjm87EfB!*_(aZDek?6N zfMD%%oa6t!<}w?6Qw2D}rlcRg!38vrx3y)J6WcyO^|-~AuaUa@%jEdPMk;-&hs66! zq^KbA9$&HUAz0V1th>De-_vGTTc=-3By}SO-+Qj}jrJ5U@JV=_{0u8XU3J0Ph_Xmg z68P09*n|5?E?Bh!ms{ab+)RX0vGpw-$Hf3&<=+iU;d}nNYlgD;Mi|kfx@nJ)<98&} z>|Bc_WHkOy1#7p!F97Co3&C_AXlG(GMNM>-#-~xQOPvNd3#5Bra3j z%9Va9U6Lui;kYceEZYj#8fLE9OO|at}R8(&(IR0Xqq=nd~7cB$>0jWGM{};oAdz3q{Cn(zp!+m-|vi z%2H&ZeHoG%$&0ivTcu?wVMg(52U{Rbm1LrgsgMQkl<4|ne7qzrPeB9)L=zK(QvMlH zYKb9q$yw*u2)&b9zP428^`xDv7P|aebv7SAm7&X5@hZyQ;V0Qf{;Tkv>5X=Xh29Q{ zKk0+8<2r=0cTHsUxRHbd%!tVoW6VQUqZGEfb|#g^@+by&pPbzLuYq$fkK&ap{XXk} zwXGcSEFST&5f7}K&(I}j{OtN$RQ4IJ#g@!`5t=!Ad{I3zNTHtL>DbP&=){3ao_HBm zpFjduy>#nU<lm zR#=-J)fvL%KR3L^wWUx}Wd_pR5wF{f??vn-^rrTq+J>q^J7!d}=63}_2QrKl3KMYWhC=8Ab@zE~h?gj>{# zg<_GY6ZK-TXb_EJiD(i_#WLX$%f$-OELwzDw2C&-E;>XfA4>+yG_eh+RE-(ReGq`U I>+0421s#RH)c^nh diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index 8f6e2ec54277d7d0aa52a6e7c53c832eb004d43b..891c14cc161b6a178923a02d5d7af4e2a55e0467 100644 GIT binary patch delta 2044 zcmbtVO-~bH5T2K{C77cQPnJel|pd}rF3@=etqcBjugGxN+x+IO?x^B-R*8X6$opl@q zFb1*dv|%*CHpxy-UTtJ=ir=80YbJez-f}oSepIjL0iME4G#XD>L7<~AgT3R0T;9?4 zT;`re%V}-|Wtfee%Q~jL|4LKSGNk@hiL_HsQT_X7%=S;-XJgtZc3pscH z!Bh{suRRygVZI%Ij(b+xdLrErZbAD(&dbgRe%wnJAbDg=R7s@TOb6!E0`1Ya#GtaG zUx}nVFX+eJ?2j2%3aM7~N)IP@!75EKy3jyk8yZ%$qerWVAp~Z!wPQl$G$Pmyq7+94 zj^ivNs0t&;890Ro@)jBCL<8X-Mo0ptaB9d%qm~+A66wLmAR*D)p{@HENaMuqBq0+GzacT>X_x$x|h}tA~YCGL_@`I6uw9AZO$`{1}0l( zgtREA0`xH?>yTn~62K&Ly3xR5qzsD*M`kUEaAXu)7*5^Sm*}y2rT4ooB4Bz_wW~2- z7y*qgOhe;GIUfj#RI<-p=|HmY4tjZd>Nk1KgMQ|bFJh(XDdI%a$syXwB@Usx!w{KM z99@{Z7Y!^V{arbL(7?E3e4BzT6jWv|X+a%f4KX`m<#3frqMU|sXhNBjNS2Ebfpn%A zEf;Z(E66M>?-`P?4MtczccEm*=)uFmQGsRK^jDfKxPB&Am^QzRp6kv#jzfR06NWO9 UNiSq49_{>mZnn__pPqgG0~Z delta 1879 zcmb_bO>0w85S^RaYHM4yN^I1mH}zHWVp}S>5JBPf+e zyqmwivvTbBY+RFd*jpO%^<7>BZ*^5 zDxxyQV^u#6>R8Oo*vu0|PpM;`7xJc8$cCk43i{H9@9Wa7$_<@H{Eb^??`NtaXMRCg=!F+i^-WJ`hb_;#ixRAX=ko83M(l z-rHc~v-`cwT^pa;k7@7LX{K9iMz=fd=3>wyZ!fy}v9zj``M2cRv#JN@BmHo}_G>>G znzZLCLS_EwWiJJ*fMI*sj){rWjF^pLIR+8Ae9034au^7_vkndp(DzaMO@8&OUU9%7 z1gNp)kU0c^PdS7wKmvbYD|3EOOPzHj_JiXbBj#_h$3A(OPzW7Uka>ql$(BQoAVAg` zhe&roxfgC6V%!5ti(oR`I2i})*aat9((o`MbK_B?4qF8*o-aF{Wdsnr?+|u~tXv<7 z2TPJ-Lb~SC77!qfouQa;WCMZ-M+VeGIy>*L)|pqDSE5Yb%dLQr1rv>E1VDIRDE)~M zv+d>9(o)i6vQtZP)5|bTneSeax4g&#_TZP69s(6`g}l=UkSE?R3?V!WX8|&{hYTk@ zaaT6>iscFX({z~&bBOi%tjmLdjaw_=B%A+n|Ki%E&pq&_%AvNj((2v*acm23+) ZcmixqRf2AG^}){ Date: Mon, 17 Nov 2025 10:48:15 -0800 Subject: [PATCH 3/9] Next phase of BDF to MEDLEYDISPLAYFONT - in progress. --- lispusers/READ-BDF | 205 +++++++++++++++++++++++++++++++-------- lispusers/READ-BDF.DFASL | Bin 21485 -> 24281 bytes 2 files changed, 165 insertions(+), 40 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index a4c28123e..3741f5533 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,19 +1,20 @@ -(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" -"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" -"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" -"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10) +(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" "BUILD-COMPOSITE" + "WRITE-BDF-TO-DISPLAYFONT-FILES" "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (IMPORT-FROM "IL" "BITBLT" +"BITMAPCREATE" "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" +"DISPLAY" "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" +"TCONC" "UTOMCODE" "UTOMCODE?" "WRITESTRIKEFONTFILE" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) +READTABLE "XCL" BASE 10) -(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101 +(IL:FILECREATED "16-Nov-2025 22:55:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;30| 56989 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH - WRITE-BDF-TO-DISPLAYFONT-FILES) - (FILE-ENVIRONMENTS "READ-BDF") + :CHANGES-TO (FILE-ENVIRONMENTS "READ-BDF") + (IL:FUNCTIONS READ-BDF BUILD-COMPOSITE GET-CHARS-PRESENT + WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE) (IL:VARS IL:READ-BDFCOMS) - :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| + :PREVIOUS-DATE "16-Nov-2025 22:37:22" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;29| ) @@ -22,9 +23,10 @@ (IL:RPAQQ IL:READ-BDFCOMS ((IL:STRUCTURES BDF-FONT GLYPH) (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME - GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING - READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) + (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR BUILD-COMPOSITE GET-CHARS-PRESENT + GET-FAMILY-FACE-SIZE-FROM-NAME GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF + READ-DELIMITED-LIST-FROM-STRING READ-GLYPH SPLIT-FONT-NAME + WRITE-BDF-TO-DISPLAYFONT-FILES WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) IL:SYSEDIT) (IL:FILES (IL:LOADCOMP) @@ -59,6 +61,7 @@ (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) (DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 15-Nov-2025 14:26 by mth") (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") @@ -92,6 +95,7 @@ (FIRSTCHAR MOST-POSITIVE-FIXNUM) (LASTCHAR MOST-NEGATIVE-FIXNUM) (CSINFO (IL:|create| CHARSETINFO)) + (IMAGEWIDTHS (IL:\\CREATECSINFOELEMENT)) (DLEFT 0) SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) (COND @@ -140,13 +144,17 @@ (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I TOTAL-WIDTH)) + + (IL:* IL:|;;| "Now WIDTHS is NOT the IMAGEWIDTHS array. BDF provides both, and MEDLEYDISPLAYFONT can persist both.") + (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH + IMAGEWIDTHS I SLUGWIDTH)) - (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) + (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| IMAGEWIDTHS) (IL:* IL:|;;| "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ") @@ -168,7 +176,8 @@ 'INPUT 'IL:REPLACE) (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) - (IL:\\FSETOFFSET WIDTHS MCODE GLW) + (IL:\\FSETOFFSET IMAGEWIDTHS MCODE GLW) + (IL:\\FSETOFFSET WIDTHS MCODE (FIRST (GLYPH-DWIDTH GL))) (INCF DLEFT GLW)) (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") @@ -292,6 +301,82 @@ :TEST #'EQL))))))))) +(DEFUN BUILD-COMPOSITE (BASE-FONT &REST FILL-FROM) (IL:* IL:\; "Edited 16-Nov-2025 18:25 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 17:04 by mth") + (LET (UCHAR-PRESENT FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) + (UNLESS (OR (TYPEP BASE-FONT 'BDF-FONT) + (STRINGP BASE-FONT) + (PATHNAMEP BASE-FONT)) + (ERROR "BASE-FONT is not a BDF-FONT, nor string, nor pathname.")) + (UNLESS (AND FILL-FROM (LISTP FILL-FROM)) + (ERROR "FILL-FROM is not a list.")) + (WHEN (OR (STRINGP BASE-FONT) + (PATHNAMEP BASE-FONT)) + (UNLESS (IL:INFILEP BASE-FONT) + (ERROR "BASE-FONT ~S doesn't exist or is unreadable." BASE-FONT)) + (MULTIPLE-VALUE-SETQ (FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) + (READ-BDF BASE-FONT :MCCS-ONLY T)) + (SETQ BASE-FONT FONT) + (SETQ UCHAR-PRESENT UC-PRESENT)) + (UNLESS UCHAR-PRESENT + (SETQ UCHAR-PRESENT (GET-CHARS-PRESENT BASE-FONT))) + (LOOP :FOR FF :IN FILL-FROM :WHEN FF :DO (COND + ((TYPEP FF 'BDF-FONT) + (SETQ UC-PRESENT (GET-CHARS-PRESENT FF))) + ((OR (STRINGP FF) + (PATHNAMEP FF)) + (UNLESS (IL:INFILEP FF) + (ERROR + "Element of FILL-FROM (~S) doesn't exist or is unreadable." + FF)) + (MULTIPLE-VALUE-SETQ (FONT FAMILY WEIGHT SLANT + EXPANSION SIZE + UC-PRESENT) + (READ-BDF FF :MCCS-ONLY T)) + (SETQ FF FONT)) + (T (ERROR + "Element of FILL-FROM (~S) is not a BDF-FONT, nor string, nor pathname." + FF))) + (LOOP :FOR GL :IN (BF-GLYPHS FF) + :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + (WHEN (AND (UTOMCODE? V) + (ZEROP (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)))) + (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)) + 1) + + (IL:* IL:|;;| + "What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?") + + (PUSH GL (BF-GLYPHS BASE-FONT))))) + BASE-FONT)) + +(DEFUN GET-CHARS-PRESENT (BFONT) (IL:* IL:\; "Edited 16-Nov-2025 17:52 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 16:40 by mth") + (UNLESS (TYPEP BFONT 'BDF-FONT) + (ERROR "BFONT is not a BDF-FONT.")) + (LET ((UCHAR-PRESENT (MAKE-ARRAY 256 :INITIAL-CONTENTS (LOOP :FOR I :FROM 0 :TO 255 :COLLECT + (MAKE-ARRAY 256 :ELEMENT-TYPE + 'BIT :INITIAL-ELEMENT 0))))) + (LOOP :FOR GL :IN (BF-GLYPHS BFONT) + :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + (WHEN (UTOMCODE? V) + (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)) + 1))) + UCHAR-PRESENT)) + (DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth") (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") @@ -509,15 +594,24 @@ X)) Y)))) -(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") +(DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1)) + (IL:* IL:\; "Edited 16-Nov-2025 22:37 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 16:35 by mth") + (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") (LET (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL (NGLYPHS 0) + (UCHAR-PRESENT (MAKE-ARRAY 256 :INITIAL-CONTENTS (LOOP :FOR I :FROM 0 :TO 255 :COLLECT + (MAKE-ARRAY 256 :ELEMENT-TYPE + 'BIT :INITIAL-ELEMENT 0)))) (*PACKAGE* (FIND-PACKAGE "BDF"))) + + (IL:* IL:|;;| "Note: The EXTERNAL-FORMAT *ought* to be :UTF-8 for the BDF files from otf2bdf, but I'm seeing :ISO8859/1. I don't know why! But I'm setting the default :EXTERNAL-FORMAT appropriately for this.") + (WITH-OPEN-FILE - (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT) + (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT :EXTERNAL-FORMAT EXTERNAL-FORMAT) (LOOP :WHILE (STRING-EQUAL "COMMENT" (SETQ KEY (READ FILE-STREAM))) :DO @@ -609,21 +703,29 @@ (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." NGLYPHS)) (SETF (BF-GLYPHS FONT) - (LOOP :REPEAT NGLYPHS :COLLECT - (PROG1 (SETQ GL (READ-GLYPH FILE-STREAM FONT)) + (LOOP :REPEAT NGLYPHS :NCONC + (PROGN (SETQ GL (READ-GLYPH FILE-STREAM FONT)) - (IL:* IL:|;;| + (IL:* IL:|;;|  "Any GLYPH with ENCODING of -1 is taken as the SLUG glyph. If multiple, the last applies.") - (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - (WHEN (EQ V -1) - (SETF (BF-SLUG FONT) - GL)))))) + (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + (COND + ((EQ V -1) + (SETF (BF-SLUG FONT) + GL) + (LIST GL)) + ((UTOMCODE? V) + (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)) + 1) + (LIST GL)) + (T NIL)))))) (ENDFONT (SETQ FONT-COMPLETE T)))))))) (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) SIZE) @@ -633,7 +735,7 @@ "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" (BF-NAME FONT) FAMILY SIZE WEIGHT SLANT EXPANSION)) - (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE))))) + (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE UCHAR-PRESENT))))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") @@ -822,6 +924,25 @@  "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)") (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) + +(DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE + &AUX FULLFILENAME) + (IL:* IL:\; "Edited 16-Nov-2025 17:32 by mth") + (UNLESS (TYPEP BDFONT 'BDF-FONT) + (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) + (DESTRUCTURING-BIND (FN-FAMILY FN-FACE FN-SIZE) + (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) + (SETQ FAMILY (OR FAMILY FN-FAMILY)) + (SETQ FACE (OR FACE FN-FACE)) + (SETQ SIZE (OR SIZE FN-SIZE)) + (MULTIPLE-VALUE-BIND (FONTDESC CSETS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (SETQ FULLFILENAME (MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME FONTDESC NIL + NIL DEST-DIR))) + + (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") + + (VALUES FULLFILENAME FONTDESC CSETS)))) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILESLOAD (IL:SYSLOAD) @@ -833,8 +954,9 @@ ) (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") - (:EXPORT "READ-BDF" - "WRITE-BDF-TO-DISPLAYFONT-FILES") + (:EXPORT "READ-BDF" "BUILD-COMPOSITE" + "WRITE-BDF-TO-DISPLAYFONT-FILES" + "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" @@ -842,16 +964,19 @@ "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" - "WRITESTRIKEFONTFILE")) + "WRITESTRIKEFONTFILE" + "MEDLEYFONT.FILENAME" + "MEDLEYFONT.WRITE.FONT")) :READTABLE "XCL" :COMPILER :COMPILE-FILE) (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR -10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 ( -GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 ( -READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 ( -READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827))))) + (IL:FILEMAP (NIL (2686 11251 (BDF-TO-CHARSETINFO 2686 . 11251)) (11253 17671 (BDF-TO-FONTDESCRIPTOR +11253 . 17671)) (17673 21069 (BUILD-COMPOSITE 17673 . 21069)) (21071 22140 (GET-CHARS-PRESENT 21071 . +22140)) (22142 25682 (GET-FAMILY-FACE-SIZE-FROM-NAME 22142 . 25682)) (25684 33114 (GLYPHS-BY-CHARSET +25684 . 33114)) (33116 34541 (PACKFILENAME.STRING 33116 . 34541)) (34543 42891 (READ-BDF 34543 . 42891 +)) (42893 43216 (READ-DELIMITED-LIST-FROM-STRING 42893 . 43216)) (43218 49709 (READ-GLYPH 43218 . +49709)) (49711 50452 (SPLIT-FONT-NAME 49711 . 50452)) (50454 54360 (WRITE-BDF-TO-DISPLAYFONT-FILES +50454 . 54360)) (54362 55433 (WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 54362 . 55433))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 927778eaf9838aafa5ba0d1b7cc9d57d42e6156d..93b1686ca5bbc85890ce4bd3a75cca537caa0c06 100644 GIT binary patch delta 10920 zcmb7K4SZD9m4ElmWbz$Cn1m2wGKLUhU?7B#1Qf|+<|Q-9WbR~Uk`N1wD1pfbp#pxi z3X?!Vt*H{8;5>>}ODbKr`)fif@)f4kw#xo&S1l^I{nS>g)vC){x7(HMIp@BaNo?JA z#k_Ogx&M3ax#!+{?z#8P`^VVjakhW$%}XlN{9A9|c5A0)Q&(@N<<@PT8+LSVv@Bk3 z^=!SvT2)!K%u-dga@n$#%c|1qZGQJunE&>^jT^qS0N@sYcW$|*bDIV0EQnVc9ZzHB zNs;}7CS{G6`vQ@{6rW;qSnC}1k-=$otuD92YUj;f?so+g^%tz9d~i;?4|qga1KirI zINVBy!{zt7Z5{R86R_61+)6~9J;vk$W*wX%09djROFXt_B{G;hNlNM#B0w!LTyC;Q zRAc1eU}~Gq=d#tg6@TQwU|O?njooSU`IUfXhxc@N4>(;Ol#w9Y!<%hhuglYrfT>yP zjmAw$ z*C8OfO*6bUdsD233;h8f7(>e94h0>*HkOv7jx=&IDI&}?aGwiYhyFtkp-}xLv&^T` zf5hXU+>;bw>(!%4?Zvg}5tT(AmLr4azco|TS*99!Nu}yH^|Dp!_f6ZwjyaKs2D8EF zR(qh;r&xJiqhb%_Xbz@1422OjBcd8KhXmu2?By;`K=F}4)^-v#>ePg79vn2*xdQ%V zDoN2x(sY`k(=4546Af#Q99>}6X`Z%oCbX;V#D5W0)^7dc?x`~`Sm|n+QJq{S7I=)5=)0i|XFlcsvY?7sUecY?~ z0xrc*qhRv4yBq^Y zCe)hZL|y;EDf+*nBd54mM;_`Q5ZJu{N(FUspU2vNB!<|hBjO{WtBAw^_W~d-t^!9y zM`$s`eL5mBW;)_<3~|4Xhz(>zT*=p`^y#a*G4V0h6&>l<6ajny5I8ns7zf@kHd1lv4XF%x)=LqH%aawWQBt4)r(Y3bsS-Oy7|0$e@)dNk_!g7<)DSQO5SG zJ2IaR+i_w1h2%d+_BX`-JF?Fa`#Q4!LhNN^RbnrFiO6d~BCje$Ua2N>aW0Xc%^>o! zn2#^TT0aT~qn_QhC&6s>+gZEWQFZ>bC27B!p*b=&hf#B=ch4#U)9;;DmFi&Wq~$zB zn|bOx)9S*juG8+y(7t3^p?!I&cK0GpnWNp4qbW>NFw$gW*ia-91r$BND0+ZVOuAeT zD~cXg6g{jcdRS3JSkV+cswjF?Q6Q>>seyc5QGreiby`GW2de+y|1j)Ow;s|IoFWu< zV&PoPrlKJzNKrg?j!{OllkAYTI}EOSgkB=_)aZE_z=pcIb_x%`h%l2}SGR`O*H@Ah zUOM70CJ3>x<559UGqfS1T2dk`nQVSLZCp6TPfKo+!VjzW^ z7>fb^lK`UsVuW>s97BAZXeTl9I>-XXvt#o}S7w@m`*Q*pn`AmJc?#~o6D`MQpbkty;5Cw@xBM4C>H`#?pK7i7mbsq_ z%YNA3-!CE_%lK@NWEm7B6$p|GZ+I7$l%yG8=j=BW((t}8oybqbME$8@rUoGbLrg4) zT@^u$T~&XXe&g8vxj$mS@|n4dU!;mJK}MWdyBO_WCHZUgyhP8-^n6`CICBdHVdh5x zv(batT4WayyBgVRh`kY61F@@smEIxt24w$@*z1vfn%I@dex2AA$POSYy}p^q;1Y6ioYV&@)zzy>MTothI6Erp(BYJ$ttG#7*a z5l9lR=2D+2XfKZgvb9DA|K}wDjWFuXVt@=Esmo_?XFJuWW_O2sCwdK+dM>?@3cZzr z+0pJ`PBauW!(Sf!<-=bA{1w7qQM8VB)Z?17%Yi$3op5H zfLjK5$r(4k>t#iVE8!L>D;eOHvm>+XmV_-sUHzel>p;x|TTy3S8a|_;P(jcFbzQ+y zXu2%QOUb|kqtYH;%1}_k%UG~H%FEFr7L6qx!VQ^ubFA7%1cwTPKk2dr2Pp=F$ z5AgDF&oW+qWyk~UxkkR=VzBCT6JK~`sA+&NJmcn-SBBgJyz(rsD8p`)%3#ds#9iE? zR$o&RE&yLahb(=JT^SlN^8#*pvGFGoNWd$W=*ZhVOV}lW>n1~Uc{V_K-X!c>I+kaf zjnO9eMR0f{&%4MAd(zPzFb*+5zS#s$u|z{*FbO>qA`gKhEHMv_a0?5Th_>^{RWbjR zg4+b2Pp<3k=J`A)Cd&y{M7w##m7(qdUUAVK6PqvcGE%LR&1lhP3HRJgF<8*`@)vmy z_9q*;Qsjz|(_1rvW?sQioWn~m1}k8aaf=My7@cV1=Hr3b6v+#gpiPaj_Z)z9!;C?b zEMSs8lfa}Bhp?%Hh;CEDq>-Y&i3w2DbFrJ}^}GTuB}is68V}CQ4nbnrT%a0?d3ZXk zTfBYXm&e;m-8!Zb zV80-cZe#U!K`QlHAem2W4;JQ9p?p=4cLn*SATJ9tjHc^12`*1PhidX3)DUL9$hVU= zVizRXYZGi8 z)P`%@m}l&iLu^+^3GsU7f5HYmVt~ z3i$Kfo0&RxQ(2hJXhzJVgxPctkuLSUc_m>Lb$vpDM~`S+1bum3XZMw3Js~~3cFvJc zhE9b}ht7n~hQ>qZLcuJEB-v4MXgUxY$*rY@H59sEh=xM_U56<`lRWA~K`=+c7~hf zU>-Zm^Wtexku zp!u7lOyOqQ&yH}jXe&E9D(#NFX);71{ zy$cqt(TFrA5UT(YhHDhOGsO7H=26*RWD7KuNLS;kr9TSEcS(XPPWd27l!mDA zTRVlGJBWl_f-DxoWJuPsY`%upW;hO7l`sZt?M_{)cx?eE9`;ZGmxXA+v(4=&L+Zn&iv6wqNjGPoc<@RnVE%ipPVTVyal zVRYQyUT9&VBQm%=p(|eYxqS&+;+=t<*DJ!GbX#8gI)?#v{_m7Rig;`GR6r%VCrWNdLz7a{ z2b&lzO|400Acb{#rip4j=4^WN#MvfTlH)z@=4YZV`P9g9CoCv0C}R3rVv)h5I@~sJ z#HB+t0gi4UvZ)y+j<_$e`Fvqp$BiUDo=GH>+^fNTx}zHA+ccNQ6>!iI0Y^{Qd z21sD6P?n*~tgt64c_7G+f#Dz$0I*+%8?zJ`DKg`)XVpS*cT42ZSaJCajJ2rmUFVv8 z7N^rK(1;1XQZxjd_!=Oq&Z*vtyp-q`dWoui71w6BX9;_!A!-cvx^GkzvmdC@ih0*P zi+#R|VFLGVn;kC8QSvTTpu%T}{gFCtey-z3ZO~#8B3HFQKa2qgI=Pwy%%{~-5>b=j zQvE@nsEw>A!PXJ`Lp3yiX~wgYVCuK$FSPy`1$0DY#EN>v>h%!d&{Y@~%xAu_MGJmz zfYc$QGM|!(MHvNPxYmEdFbU|G$PPo9e2Nslf$aB)MSv`_ zJz~Xi_Dz(EnL$!NI4mguqi4qgacHJM`Y|b?{PHWr{uTgib&PG1SS5JS*lzPtKJ!8x zt{A$UgRRD53a`n<@D&R<8u;{` z0ry>G2T6+6*aZ#-C7LryAf~{d)V3uSW>@cA za*2JSdY8Jw=v{F|%>D=2C#fP1r}Pl9dyw6WtTZgl-BT;xmY|(YN=G~QIlQF=-ZWDX z<4!0`YH8&GrHdq2#a3{YK~E=tE>rWD-3A|`zPhYD-7jX+CrtCJE{V4_}vYZRwAs8Sg1f@e{*4^E@S zRNE{$&2kU1PHVO#o4{SE75Ev^)}T~qfn>~35(!FDWYCBkF8TdMh!x3gim#6Q74q#d z5KL3nK(O&Z$gJnSW}Aqe3Q9BiIZgPiA5%%^W!k z*^fYd{Lm%6r=_6qZ8UgFkb8q_KaGWA@sA-Z*3tKn#dWk!VuVl$d}1}IPIdWtP0g|u zix$(8l(WjI>{t#GInw}7Rw$-|aij3qg+khoHiA<#qLk$B@BgavLZMnzJ!ifsi>5$} z5&%-7&I_i;caItl10Y^4C;H7%!(O$wx}2?54^~&phB@j_t6Oqj(i_MUsq?7(eRXlo zY&HzfnMuazsC*xCYJZK9^^z?XR)4jkWhPu69cvs1Yn>NT$PDafUQ~6hywQJrCJ1TU zc3#K>Av{9`BlDdXvZ!mvEzS!C@bcz~bMSb-Sf)X z(TR5T8!PkKM)l;%_H3wJ%95!RS5}c)czsRy&U6NwJC4FZ{IU%H!$klOKpJdayky1F zDm=6s*TZy3Z?m~u6~9$adyOLAV!mpufnt-GnDA=&SZhHd;x&dEg9xlgkzJ*=A<3gA zL%Wy5BoI?I1Y#MZxjc6fvh?+YokR9(IvCj7i9M`-ay?JM8q&*JtLnL7R?0b1GOTXB zVRl|IrN+{J`q&{Ci{KPeAHSg}Tx>=Sa!D$*WW;avxDOi3DR>*+fE+p*E=9yAW+*T` zAPSrmTBPh8`NGM;C4xwZ%WGMSr&9b2(tX32+Bc%sWqUY|vBFV!b zk5bFFc?t!o1>uq;!X44^4&VkiI ztHybuh*pyLd@3(zF<;?a?PnCx^)hxLlM3o^S4vy!4fvd` zo~FgikHC~!QFj+>Rgc$|R<4iWM>Myq*%dIl311{~h+UM4NW&DV*prOTS<_az}Y1s0@INQrk!`VK0WZ{V6kM7h^j!KsQGygXlX%q8y9 zEDb&Zp`zE4@dpOTy^8%+EsZBxyL!2CXSm%6wj_>q^ivwsdW6cB07Sbj)nSqM>dPLFeU;st%wgGhGfoFAX;@; z{qWh}jaMVm6QnwnLgdM85Xr(#UqiM`P4^aW*o6vTLWCSfb}6!AZ5i12ARV0F0Y z04z~BlF0?Ir=zoO6J4g~_GIkv4`2-b_U{X^6u%yP_BV-P{SHgNyrLNO4b9W7wdh|b z^pP{QYmR@w(`+65z|k}15^E*iEA5&qJqm80pEw;*E|@NiaF%vRZYT zZ+1#8gWvEOwPk9RZ=NMd%lW%M%&hoFf0(J|k7dj0|KFcxKH_)e)M~xpJ=w!4u*uI& GO#CmwnW|6# delta 8117 zcmai33w)DRmjCXTG%0;RC~cvogiuPUK)_OJ(qRoMC6zRe!syqcc8c*_BZQ_MCISB;ZeX ze{FKkJ@dPq0sZ#`bh|SJ&i(?%2Bd<{sPkHr(1{yLod@_xF2lvDp^c z{da7$&%bg0LfibBrPVhsU09vdpoF~F!@|8=H*dM6`<^+rMK-|q+_tV~vke=~Nw*q4 zp2La_i9K#OAN+yeafnE zlgD4*qy#k-Sp2F_2?RX;MihnIVUY4%{2(Mg-{|cOG==QWPJ2edV0=PAsc&iUc-?-*=bjr12cZM%FKr~~xHGGw3U%a=;iQN# z<3a(iCro|Xu{{b0*Vtrel5GmJ4!*|JQNBDk!C7LjoQM~Gn^X72YX@d7l&foazWG+R zgx_o4!W{fl^TeowX%0hKg6Ac;L32oneQ|R@_4vc?APHn`8&RW9P1wi2xY6kehs;!y zt=Ht}G*72vb!yRRfldo`TC8oGnBY-><6nZy+P$Fa`akGlQet;p4umuZcqZScw779f z$r(5`c_1~WoDw&NJgdn)@m#0c=68XYo$4xbVvf%ZUat>{DFr77f@;7W46pXMLj*8| zIy|m$li*z$-Yn$RRACksdZE4DT~E^wMwrCJ6UrF!w!!rB?lEQKci@DkEVc(gx@*k5 zwRJHmMlLsL+a*cb8G}KZL|DYMyP%2L*^ruRE-()v#_08g!ZGb`9ib0bN5o^K>`+X* zhfm9y5C!*$rVmRnQPA3q)7t0`N^(rQ4^-qsC)c?}$L~rjx?e}>&Jw=TQM+UPG3|!{ z7z1k3&eJRR#QLK#Evnb1-Kp0OU{f4;3;;Rl=IB-(F_=R1>xhiwbp%f#w(E$@YzRc1 zv^PBt?CSyDnDj*HiuT1cMF4*U2z0zYef_zM*n|9;+?n=A68oiW$4j6@vPfk3Bfv7v zfNKu^<0jSF46z_FS#$8byjkovUYpl#apY;Zyd>!WHQF)q*Lg#X?cfb#pN`g{O_xai zHnQ&%dk)!Gi9L(#-xGTVSx)Tfdx)Hh5P8c@Fx7{PR3sTEA`w9FslV7b)%IY<~Y`STWMbjc0coq5`3 z(-LjV0`2?rG-bNBwLnvtreON8U@lN3v9=XGYbbiwP)xd9&lQTED-=CfD0;3?^jx9n zxkAx%g#x)EN*zqn6_x6=Os7^#CeZx<{=zOJ80blBl3sY>0G5YG~6h1hSS-ZE|?&1!UjVXSw84P zq^qnxfG!#HX2lGBdA(zD|KYyB3s+2px1e1^OI7x)alpA}~?uiby?2ge(69$XsD|Dvoqz zSFgkUR|b~~GJ#{#b+`+ep3@Pi0~rFRNRr<3e*;pVpmcolf}(YGUkJ-i#9}d#@mSV3 z6DP}pNcr}}sbJ!CU?lxJd?ZS)F+&+m`^)2rydnblRl`ILQU|7H7?QpXKW(-A2iog;2nj;+I0~5@hEQ zyBOIi#MUBfAa)V3(nrKDM3y>X3y^)9q&3JsO6+`O`;nE-t|xNFN91&^HXWs>L^gkm zvN@~1KASTW-&XP@eA`MV7rbMvAeAd7XiB~YNmqeHUS4^P8<|LL@5#b}?}O(=erHv@ zY;qMpQQA=AVw#H;!8r`3H@jZ-hr$Y^p-q|#5Upj6X6m9z9;dk({3DPg9?i{nOzx;k z11wqtga6_TpaG)6BPPgjl4qA~VeS0Bvc70v#FFfd6u_qtKE?2v1fNp)lqH?C+dkFe zj1-u_8PaI!#&ZB`iCB}WE-8!HlB!j;T^LlY{i^MGFP8N>E8=Xb73ysLs`dD>$<7+v zz=l}wUMFaI=nhmFb><*R_V$)WtkBjIDTl5rl4|)Fln)L|52)n~1va&UMJkhOg&e8U zt%=M^sybg5nUm(Nk+~^ett_0B^r@AXFAVtl)yflowerG%AGlvOtFz8UZhUS=i#q4R zKuf_rid;U!8kgt*XRfl*?eu@YTCjD=)E@M<*rwa6s1E8M`oWtWce#T2D2< zA%O(EVoe_VP#r7mlE8J>LW|TgfU1SpU_a2YYFVK%+2TD14sTWq #wb8*-(4=F%# zp$VK~P4-5?B=k%#c?cX~O?gODtt?^_eHW9fQvN9iw+Vg{xvsBIEmkclSwW;K*{4=r z80hO)tIl~-VlbnERO@6tTC`r`uT9PAfk9WEQY|==GUUpUv#90gB2^Gas#OL{hp(4_3Zpwgm@D!*955V_)np0!NUI065DX45~pWNv~jk zU5eMM);r-7Z9(A?La)1-NOxHC&K2Ags5CqaEzCi8z^l~LFhq{J8LRd~RhGveXrlqa zVHt%R1nCsSMw$pcnb=zplSP&Cr&<)7$iEZCHwAf7kiBTBepB}N8&m{tAr(EyHfC7b z2pCCeGY~B0Gh*2|29VI+4<3_fX_s>w7m!F>Ty%|41_#!f`8(BIjvu(&4wPqmF6IwIx zs+`;y{Q;q(y@Ip}(uf|#Cxk#QfMt={hp_n*I1MfjT=6p4p!6NLXu^)yTCSSoan!)7CR*O@<+9pZE5&x{_% z=2yV}F*uz{Jv<*vvhO9rsI)ODv>@oiK`~`W3ufg%6nz{BTP(WKNxHsL9SZoOGQ0fva z-&8Z3c}EV^{HtNIHy?snzvCGbaU;$cq0(VdlvfH03}SER{Ega)c?VG-UAir`{TV-Cv=81u!hb3y@-qLA#mk~cvGac* z!7IrA4Y98xdx+RyBTE+~Hi~SVq}Ys&inS*)2kR0`@B=}PYjp724pVRO_&s5d;97lLZIE|UrD_;Pw#NlvPq@=aJ)YzvOTz3F&tB?aySQg* zW$laL0;)QNc8Nj#HZ6c)MjNjYi1_*~Kf2Tg4~DNUJYVb!dAV<C? zEVAU|AzW&@Tv(di0N-VN*~-!=0|Um)!gorg(LGD^%itwF_ze*J0R`U1Ks)P5#LeyQ zpi>RG<*k~j1DfSEc>FHA-qd&pOrqE?`n2pG)S6BRYoRL7?REQLs_fy;fZKrf?nS%H zCCOMtrZ$b1lC`&hX?aOHqV0+81S!|*rn6FhqHf}Z?rT8>$;XBbUjAWS6`Rg2j#^p% zn0p+p1qofC#sz#Z99YIx{7Qr4O1$^XRPb`D4Sb`c!()PBnT7`r{Y-)xMm|Z}iN%B=&zOf&jik6~$PZ@#TZ!fTS1xrmwvf(f zxTi}`Vqc*)XUN@(MS2fo2L$@kCaAQ~qjy6P%ogvUH=!n3@*t6R)Qgf>6y1D-+u9)& zlFTp$S{t!7<>JpMlNg?aONSpgl!5)BE3tJhe0B}ASC|?TEyN|hsO!Sha)2me_*TG7c#U$^fiHj zza-SVAutv$&PEkKrFxpE9}{~Y9V4Wn)l~Xn0}|OtJArI0qLP7s+4MLh)gjNe5`3f@ zt0!tm3L%f`*XkA~;&%RmX9BNl?!H;t0T;glSO&B>nnufL!H8E>c_O?)h@_0M8)JFY zK?$6qu-j5e3MSxn&D9{It&~#b>6j36x&q-~Q=7k~deH$*<>r>VnaX1=6)Q10x!hil z&l5I!Q3<;$_O!di%h*r>8mt5x+b9Lmfmz$csu3y;@pCP+=dmxqsPFXKqD2OA!u^VD zWtaFoZ|$=GcO12eIJ3>%wMOoukxeK4a>W5HFml*CXkY=pAkZ46B^DvG@t7uyO`Mh( zZOQU@l#;QsglraJ9|e~EDZ|pE23reK>2tCAKB7vRX4>H-JZwt8&PXYKqcTIWzBZ8+ z3;PnXKS8i8-%muMVMrI-Ny8Q4;w$q-$tH+6DPEZi%~H38HDc{~1gRIKQV^S_EJ0|Y zD8lOwmc&6_{t{*lS2J!TVxfLQ_3|p}>kvQQIy35o223o?%g7!h2zy+ReS*NdFV^7? z6YyFKKMi4Nvk>;7GKm(tu#~ltgcf>}z=)lk7J7}4%qGkpd>>|3Au1*jt#pYb(nXT| z8TFqQl4rq!G4R9^45tSr{T-s@DXQiWS?}x$%~4A&&&<{wGl)A~qB-bANIGT49~V&N zTX=ur?+2e@t^ASD{n1t<*pm5if_@(}iG0e!kS((VY6#9)s$ZOO4%$%*8zQr1-*_q= z%px1u5iz+(SK_Wt_KLtiVkX#8!{S}`%3XH0%MO7Pq(`2S{oy-g7UZUm8^(`9GgE`& z^LRVS)YrJ9V;_5u|E9yXIEtecVG=WtJQ1WNEA$@h)L-6G9#S5@>m{fOX zQ}6REAd-cfevE7-e|^=|Zd_vQG$BwETr%NXtgU?_H*crP&P_yCts~Mww*$FdRLG2N`6--3-=HGigS=2(MP@Qt6sjl4uF9%)&V!}tR?xeAtRJ)lbVs}kj$p{rN_ E7YxRW@Bjb+ From b10d90b42fb569572e2a47b1ac3a1e4bb9524813 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Wed, 19 Nov 2025 22:07:50 -0800 Subject: [PATCH 4/9] More progress on composite files. WRITE-BDF-TO-DISPLAYFONT-FILES is deprecated (but symbols imported from IL: only for use there are not yet removed from :IMPORT-FROM) --- lispusers/READ-BDF | 458 +++++++++++++++++++++++++++------------ lispusers/READ-BDF.DFASL | Bin 21485 -> 27572 bytes lispusers/READ-BDF.TEDIT | Bin 9819 -> 22202 bytes 3 files changed, 320 insertions(+), 138 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index a4c28123e..a6855618c 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,30 +1,33 @@ -(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" +(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" "BUILD-COMPOSITE" + "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" -"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10) +"WRITESTRIKEFONTFILE" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10) -(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101 +(IL:FILECREATED "19-Nov-2025 22:01:49" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;37| 59108 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH - WRITE-BDF-TO-DISPLAYFONT-FILES) - (FILE-ENVIRONMENTS "READ-BDF") + :CHANGES-TO (FILE-ENVIRONMENTS "READ-BDF") + (IL:FUNCTIONS BUILD-COMPOSITE READ-BDF WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE + WRITE-BDF-TO-DISPLAYFONT-FILES GET-FAMILY-FACE-SIZE-FROM-NAME READ-GLYPH + GET-CHARS-PRESENT) + (IL:STRUCTURES BDF-FONT XLFD) (IL:VARS IL:READ-BDFCOMS) - :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| + :PREVIOUS-DATE "18-Nov-2025 21:22:35" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;36| ) (IL:PRETTYCOMPRINT IL:READ-BDFCOMS) (IL:RPAQQ IL:READ-BDFCOMS - ((IL:STRUCTURES BDF-FONT GLYPH) + ((IL:STRUCTURES BDF-FONT GLYPH XLFD) (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME - GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING - READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) + (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR BUILD-COMPOSITE GET-CHARS-PRESENT + GET-FAMILY-FACE-SIZE-FROM-NAME GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF + READ-DELIMITED-LIST-FROM-STRING READ-GLYPH SPLIT-FONT-NAME + WRITE-BDF-TO-DISPLAYFONT-FILES WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) IL:SYSEDIT) (IL:FILES (IL:LOADCOMP) @@ -41,7 +44,7 @@ (METRICSSET 0 :TYPE (INTEGER 0 2)) (PROPERTIES NIL :TYPE LIST) SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) - (SLUG NIL :TYPE GLYPH)) + (XLFD NIL :TYPE XLFD)) (DEFSTRUCT GLYPH "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" @@ -52,6 +55,23 @@ (ASCENT 0 :TYPE INTEGER) (DESCENT 0 :TYPE INTEGER)) +(DEFSTRUCT XLFD + "Hold a parsed XLFD font descriptor" + (FOUNDRY NIL :TYPE STRING) + (FAMILY NIL :TYPE STRING) + (WEIGHT NIL :TYPE STRING) + (SLANT NIL :TYPE STRING) + (EXPANSION NIL :TYPE STRING) + (ADD¬STYLE¬NAME NIL :TYPE STRING) + (PIXEL¬SIZE 0 :TYPE INTEGER) + (POINT¬SIZE 0 :TYPE INTEGER) + (RESOLUTION¬X 0 :TYPE INTEGER) + (RESOLUTION¬Y 0 :TYPE INTEGER) + (SPACING NIL :TYPE STRING) + (AVERAGE¬WIDTH 0 :TYPE INTEGER) + (CHARSET¬REGISTRY NIL :TYPE STRING) + (CHARSET¬ENCODING NIL :TYPE STRING)) + (DEFCONSTANT MAXCHARSET 255) (DEFCONSTANT MAXTHINCHAR 255) @@ -59,6 +79,7 @@ (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) (DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 15-Nov-2025 14:26 by mth") (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") @@ -92,6 +113,7 @@ (FIRSTCHAR MOST-POSITIVE-FIXNUM) (LASTCHAR MOST-NEGATIVE-FIXNUM) (CSINFO (IL:|create| CHARSETINFO)) + (IMAGEWIDTHS (IL:\\CREATECSINFOELEMENT)) (DLEFT 0) SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) (COND @@ -140,13 +162,17 @@ (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I TOTAL-WIDTH)) + + (IL:* IL:|;;| "Now WIDTHS is NOT the IMAGEWIDTHS array. BDF provides both, and MEDLEYDISPLAYFONT can persist both.") + (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH + IMAGEWIDTHS I SLUGWIDTH)) - (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) + (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| IMAGEWIDTHS) (IL:* IL:|;;| "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ") @@ -168,7 +194,8 @@ 'INPUT 'IL:REPLACE) (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) - (IL:\\FSETOFFSET WIDTHS MCODE GLW) + (IL:\\FSETOFFSET IMAGEWIDTHS MCODE GLW) + (IL:\\FSETOFFSET WIDTHS MCODE (FIRST (GLYPH-DWIDTH GL))) (INCF DLEFT GLW)) (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") @@ -292,59 +319,139 @@ :TEST #'EQL))))))))) -(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") +(DEFUN BUILD-COMPOSITE (BASE-FONT &REST FILL-FROM) (IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth") + (IL:* IL:\; "Edited 16-Nov-2025 18:25 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 17:04 by mth") + (LET (UCHAR-PRESENT FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) + (UNLESS (AND FILL-FROM (LISTP FILL-FROM)) + (ERROR "FILL-FROM is not a list.")) + (COND + ((OR (STRINGP BASE-FONT) + (PATHNAMEP BASE-FONT)) + (UNLESS (IL:INFILEP BASE-FONT) + (ERROR "BASE-FONT ~S doesn't exist or is unreadable." BASE-FONT)) + (MULTIPLE-VALUE-SETQ (FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) + (READ-BDF BASE-FONT :MCCS-ONLY T)) + (SETQ BASE-FONT FONT) + (SETQ UCHAR-PRESENT UC-PRESENT)) + ((TYPEP BASE-FONT 'BDF-FONT) + (SETQ UCHAR-PRESENT (GET-CHARS-PRESENT BASE-FONT))) + (T (ERROR "BASE-FONT is not a BDF-FONT, nor string, nor pathname."))) + (UNLESS UCHAR-PRESENT) + (LOOP :FOR FILL-FONT :IN FILL-FROM :WHEN FILL-FONT :DO + (COND + ((OR (STRINGP FILL-FONT) + (PATHNAMEP FILL-FONT)) + (UNLESS (IL:INFILEP FILL-FONT) + (ERROR "Element of FILL-FROM (~S) doesn't exist or is unreadable." FILL-FONT + )) + (MULTIPLE-VALUE-SETQ (FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) + (READ-BDF FILL-FONT :MCCS-ONLY T)) + (SETQ FILL-FONT FONT)) + ((NOT (TYPEP FILL-FONT 'BDF-FONT)) + (ERROR "Element of FILL-FROM (~S) is not a BDF-FONT, nor string, nor pathname." + FILL-FONT))) + (LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT) + :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + + (IL:* IL:|;;| + "Need to change this use of UTOMCODE? based on the CHARSET¬REGISTRY of the XLFD of FILL-FONT") + + (WHEN (AND (UTOMCODE? V) + (ZEROP (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)))) + (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)) + 1) + + (IL:* IL:|;;| + "What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?") + + (PUSH GL (BF-GLYPHS BASE-FONT))))) + BASE-FONT)) + +(DEFUN GET-CHARS-PRESENT (BFONT) (IL:* IL:\; "Edited 16-Nov-2025 17:52 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 16:40 by mth") + (UNLESS (TYPEP BFONT 'BDF-FONT) + (ERROR "BFONT is not a BDF-FONT.")) + (LET ((UCHAR-PRESENT (MAKE-ARRAY 256 :INITIAL-CONTENTS (LOOP :FOR I :FROM 0 :TO 255 :COLLECT + (MAKE-ARRAY 256 :ELEMENT-TYPE + 'BIT :INITIAL-ELEMENT 0))))) + (LOOP :FOR GL :IN (BF-GLYPHS BFONT) + :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + (WHEN (UTOMCODE? V) + (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)) + 1))) + UCHAR-PRESENT)) + +(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (FONTNAME) (IL:* IL:\; "Edited 18-Nov-2025 15:15 by mth") + (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth") (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) - (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME - PIXEL-SIZE POINT-SIZE) - (SPLIT-FONT-NAME (BF-NAME BDFONT)) (IL:* IL:\; "Parse as XLFD format") - (DECLARE (IGNORE FOUNDRY ADD_STYLE_NAME)) (IL:* IL:\; - "Don't need FOUNDRY or ADD_STYLE_NAME") - (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) - (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) - '((#\R . MEDIUM) - (#\M . MEDIUM) - (#\N . MEDIUM) - (#\B . BOLD) - (#\D . BOLD) - (#\L . LIGHT))))) - 'MEDIUM)) (IL:* IL:\; "DemiBold => BOLD") - (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) - '((REGULAR) - (#\R . REGULAR) - (#\I . ITALIC) - (#\O . ITALIC))))) - 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") - (IL:* IL:\; "Ignore others") - (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) - '((#\R . REGULAR) - (#\N . REGULAR) + (UNLESS (STRINGP FONTNAME) + (IL:\\ILLEGAL.ARG FONTNAME)) + (FLET ((PARSE-P-SIZE (SZSTR) + (COND + ((ZEROP (LENGTH SZSTR)) + -1) + ((PARSE-INTEGER SZSTR :JUNK-ALLOWED T)) + (T -1)))) + (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD¬STYLE¬NAME PIXEL¬SIZE + POINT¬SIZE RESOLUTION¬X RESOLUTION¬Y SPACING AVERAGE¬WIDTH + CHARSET¬REGISTRY CHARSET¬ENCODING) + (SPLIT-FONT-NAME FONTNAME) + + (IL:* IL:|;;| "Now, parse pieces as XLFD format") + + (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) + (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) + '((#\R . MEDIUM) + (#\M . MEDIUM) + (#\N . MEDIUM) (#\B . BOLD) - (#\S . COMPRESSED) - (#\C . COMPRESSED))))) - 'REGULAR)) (IL:* IL:\; + (#\D . BOLD) + (#\L . LIGHT))))) + 'MEDIUM)) (IL:* IL:\; "DemiBold => BOLD") + (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) + '((REGULAR) + (#\R . REGULAR) + (#\I . ITALIC) + (#\O . ITALIC))))) + 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") + (IL:* IL:\; "Ignore others") + (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) + '((#\R . REGULAR) + (#\N . REGULAR) + (#\B . BOLD) + (#\S . COMPRESSED) + (#\C . COMPRESSED))))) + 'REGULAR)) (IL:* IL:\;  "S is for \"SemiCondensed\", Assuming \"Condensed\"") - (IL:* IL:|;;| - "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") - - (WHEN (AND (EQ WEIGHT EXPANSION) - (EQ EXPANSION 'BOLD)) - (SETQ EXPANSION 'REGULAR)) - (WHEN (ZEROP (LENGTH PIXEL-SIZE)) - (SETQ PIXEL-SIZE NIL)) - (SETQ POINT-SIZE (COND - ((ZEROP (LENGTH POINT-SIZE)) - NIL) - ((SETQ POINT-SIZE (PARSE-INTEGER POINT-SIZE :JUNK-ALLOWED T)) - (CEILING POINT-SIZE 10)) - (T NIL))) - (LIST FAMILY (LIST WEIGHT SLANT EXPANSION) - (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) - POINT-SIZE - (FIRST (BF-SIZE BDFONT)))))) + (IL:* IL:|;;| + "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") + + (WHEN (AND (EQ WEIGHT EXPANSION) + (EQ EXPANSION 'BOLD)) + (SETQ EXPANSION 'REGULAR)) + (SETQ PIXEL¬SIZE (PARSE-P-SIZE PIXEL¬SIZE)) + (SETQ POINT¬SIZE (PARSE-P-SIZE POINT¬SIZE)) + (MAKE-XLFD :FOUNDRY FOUNDRY :FAMILY FAMILY :WEIGHT WEIGHT :SLANT SLANT :EXPANSION + EXPANSION :ADD¬STYLE¬NAME ADD¬STYLE¬NAME :PIXEL¬SIZE :POINT¬SIZE :RESOLUTION¬X + RESOLUTION¬X :RESOLUTION¬Y RESOLUTION¬Y :SPACING SPACING :AVERAGE¬WIDTH + AVERAGE¬WIDTH :CHARSET¬REGISTRY CHARSET¬REGISTRY :CHARSET¬ENCODING + CHARSET¬ENCODING)))) (DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") @@ -509,15 +616,25 @@ X)) Y)))) -(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") +(DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1)) + (IL:* IL:\; "Edited 18-Nov-2025 19:39 by mth") + (IL:* IL:\; "Edited 14-Nov-2025 16:35 by mth") + (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") (LET - (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL (NGLYPHS 0) + (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL XLFD (NGLYPHS + 0) + (UCHAR-PRESENT (MAKE-ARRAY 256 :INITIAL-CONTENTS (LOOP :FOR I :FROM 0 :TO 255 :COLLECT + (MAKE-ARRAY 256 :ELEMENT-TYPE + 'BIT :INITIAL-ELEMENT 0)))) (*PACKAGE* (FIND-PACKAGE "BDF"))) + + (IL:* IL:|;;| "Note: The EXTERNAL-FORMAT *ought* to be :UTF-8 for the BDF files from otf2bdf, but I'm seeing :ISO8859/1. I don't know why! But I'm setting the default :EXTERNAL-FORMAT appropriately for this.") + (WITH-OPEN-FILE - (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT) + (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT :EXTERNAL-FORMAT EXTERNAL-FORMAT) (LOOP :WHILE (STRING-EQUAL "COMMENT" (SETQ KEY (READ FILE-STREAM))) :DO @@ -542,7 +659,9 @@ (COND ((EQ KEY 'FONT) (SETF (BF-NAME FONT) - LINE)) + LINE) + (SETF (BF-XLFD FONT) + (GET-FAMILY-FACE-SIZE-FROM-NAME LINE))) (T (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) (CASE KEY @@ -609,38 +728,61 @@ (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." NGLYPHS)) (SETF (BF-GLYPHS FONT) - (LOOP :REPEAT NGLYPHS :COLLECT - (PROG1 (SETQ GL (READ-GLYPH FILE-STREAM FONT)) - - (IL:* IL:|;;| - "Any GLYPH with ENCODING of -1 is taken as the SLUG glyph. If multiple, the last applies.") - - (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - (WHEN (EQ V -1) - (SETF (BF-SLUG FONT) - GL)))))) + (LOOP :REPEAT NGLYPHS :NCONC + (PROGN (SETQ GL (READ-GLYPH FILE-STREAM FONT)) + (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + (COND + ((EQ V -1) + + (IL:* IL:|;;| + "Any GLYPH with ENCODING of -1 will be ignored.") + + NIL) + ((UTOMCODE? V) + + (IL:* IL:|;;| + "Need to change this based on the CHARSET¬REGISTRY of the XLFD") + + (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) + (LOGAND V 255)) + 1) + (LIST GL)) + (T NIL)))))) (ENDFONT (SETQ FONT-COMPLETE T)))))))) - (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) - SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) - (WHEN VERBOSE - (FORMAT *STANDARD-OUTPUT* - "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" - (BF-NAME FONT) - FAMILY SIZE WEIGHT SLANT EXPANSION)) - (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE))))) + (WHEN VERBOSE + + (IL:* IL:|;;| "The SIZE reported needs clarification:") + + (FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Sizes: Font: ~A Pixel: ~A Point: ~A (decipoints)~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" + (BF-NAME FONT) + (XLFD-FAMILY XLFD) + (FIRST (BF-SIZE FONT)) + (XLFD-PIXEL¬SIZE XLFD) + (XLFD-POINT¬SIZE XLFD) + (XLFD-WEIGHT XLFD) + (XLFD-SLANT XLFD) + (XLFD-EXPANSION XLFD))) + (VALUES FONT (XLFD-FAMILY XLFD) + (XLFD-WEIGHT XLFD) + (XLFD-SLANT XLFD) + (XLFD-EXPANSION XLFD) + (LIST (FIRST (BF-SIZE FONT)) + (XLFD-PIXEL¬SIZE XLFD) + (XLFD-POINT¬SIZE XLFD)) + UCHAR-PRESENT)))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT))) (READ-DELIMITED-LIST DELIMIT SI))) -(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") +(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 17-Nov-2025 20:03 by mth") + (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth") (IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth") (IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth") @@ -677,7 +819,7 @@ (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) (CASE KEY (ENCODING (SETF (GLYPH-ENCODING GLYPH) - (IF (EQUAL -1 (FIRST ITEMS)) + (IF (EQL -1 (FIRST ITEMS)) ITEMS (FIRST ITEMS)))) (SWIDTH (SETF (GLYPH-SWIDTH GLYPH) @@ -762,10 +904,10 @@ (LIST NIL NAME)))) -(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE - (CHAR-SETS T) +(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED - RAW-UNICODE-MAPPING) + RAW-UNICODE-MAPPING (CHAR-SETS T)) + (IL:* IL:\; "Edited 18-Nov-2025 15:37 by mth") (IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth") (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") @@ -788,40 +930,76 @@ (<= 0 CS MAXCHARSET))) CHAR-SETS))) (T (ERROR "Invalid specification of :CHAR-SETS ~S~%" CHAR-SETS))) - (DESTRUCTURING-BIND (FN-FAMILY FN-FACE FN-SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) - (SETQ FAMILY (OR FAMILY FN-FAMILY)) - (WHEN RAW-UNICODE-MAPPING - (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) - (SETQ FACE (OR FACE FN-FACE)) - (SETQ SIZE (OR SIZE FN-SIZE)) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) - (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (UNLESS (EQ CHAR-SETS T) - (SETQ CSETS (INTERSECTION CHAR-SETS CSETS)) - (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) - (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS - (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME FAMILY SIZE FACE - "DISPLAYFONT" CS)))) - (IF WRITE-UNMAPPED - (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE - UNMAPPED-FONTDESC CS - (PACKFILENAME.STRING - :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME (FONTPROP - UNMAPPED-FONTDESC - 'IL:FAMILY) - SIZE FACE "DISPLAYFONT" CS)))) - (SETQ UNICODE-CSETS NIL)) - - (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") - - (IL:* IL:|;;| + (LET ((XLFD (BF-XLFD BDFONT))) + (SETQ FAMILY (OR FAMILY (XLFD-FAMILY XLFD))) + (WHEN RAW-UNICODE-MAPPING + (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) + (SETQ FACE (OR FACE (LIST (XLFD-WEIGHT XLFD) + (XLFD-SLANT XLFD) + (XLFD-EXPANSION XLFD)))) + (SETQ SIZE (OR SIZE (AND (>= (XLFD-PIXEL¬SIZE XLFD) + 0) + (XLFD-PIXEL¬SIZE XLFD)) + (AND (>= (XLFD-POINT¬SIZE XLFD) + 0) + (CEILING (XLFD-POINT¬SIZE XLFD) + 10)) + (FIRST (BF-SIZE BDFONT)))) + (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE MAP-UNKNOWN-TO-PRIVATE + RAW-UNICODE-MAPPING) + (UNLESS (EQ CHAR-SETS T) + (SETQ CSETS (INTERSECTION CHAR-SETS CSETS)) + (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) + (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS + (PACKFILENAME.STRING :BODY DEST-DIR :NAME + (IL:\\FONTFILENAME FAMILY SIZE FACE + "DISPLAYFONT" CS)))) + (IF WRITE-UNMAPPED + (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE + UNMAPPED-FONTDESC CS + (PACKFILENAME.STRING + :BODY DEST-DIR :NAME + (IL:\\FONTFILENAME (FONTPROP + UNMAPPED-FONTDESC + 'IL:FAMILY) + SIZE FACE "DISPLAYFONT" CS)))) + (SETQ UNICODE-CSETS NIL)) + + (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") + + (IL:* IL:|;;|  "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)") - (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) + (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) + +(DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE + &AUX FULLFILENAME) + (IL:* IL:\; "Edited 18-Nov-2025 15:37 by mth") + (IL:* IL:\; "Edited 16-Nov-2025 17:32 by mth") + (UNLESS (TYPEP BDFONT 'BDF-FONT) + (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) + (LET ((XLFD (BF-XLFD BDFONT))) + (SETQ FAMILY (OR FAMILY (XLFD-FAMILY XLFD))) + (SETQ FACE (OR FACE (LIST (XLFD-WEIGHT XLFD) + (XLFD-SLANT XLFD) + (XLFD-EXPANSION XLFD)))) + (SETQ SIZE (OR SIZE (AND (>= (XLFD-PIXEL¬SIZE XLFD) + 0) + (XLFD-PIXEL¬SIZE XLFD)) + (AND (>= (XLFD-POINT¬SIZE XLFD) + 0) + (CEILING (XLFD-POINT¬SIZE XLFD) + 10)) + (FIRST (BF-SIZE BDFONT)))) + (MULTIPLE-VALUE-BIND (FONTDESC CSETS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (SETQ FULLFILENAME (MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME FONTDESC NIL + NIL DEST-DIR))) + + (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") + + (VALUES FULLFILENAME FONTDESC CSETS)))) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILESLOAD (IL:SYSLOAD) @@ -833,8 +1011,8 @@ ) (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") - (:EXPORT "READ-BDF" - "WRITE-BDF-TO-DISPLAYFONT-FILES") + (:EXPORT "READ-BDF" "BUILD-COMPOSITE" + "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" @@ -842,16 +1020,20 @@ "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" - "WRITESTRIKEFONTFILE")) + "WRITESTRIKEFONTFILE" + "MEDLEYFONT.FILENAME" + "MEDLEYFONT.WRITE.FONT")) :READTABLE "XCL" :COMPILER :COMPILE-FILE) (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) +(IL:PUTPROPS IL:READ-BDF IL:COPYRIGHT (IL:NONE)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR -10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 ( -GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 ( -READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 ( -READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827))))) + (IL:FILEMAP (NIL (3325 11890 (BDF-TO-CHARSETINFO 3325 . 11890)) (11892 18310 (BDF-TO-FONTDESCRIPTOR +11892 . 18310)) (18312 21261 (BUILD-COMPOSITE 18312 . 21261)) (21263 22332 (GET-CHARS-PRESENT 21263 . +22332)) (22334 26224 (GET-FAMILY-FACE-SIZE-FROM-NAME 22334 . 26224)) (26226 33656 (GLYPHS-BY-CHARSET +26226 . 33656)) (33658 35083 (PACKFILENAME.STRING 33658 . 35083)) (35085 44000 (READ-BDF 35085 . 44000 +)) (44002 44325 (READ-DELIMITED-LIST-FROM-STRING 44002 . 44325)) (44327 50925 (READ-GLYPH 44327 . +50925)) (50927 51668 (SPLIT-FONT-NAME 50927 . 51668)) (51670 56008 (WRITE-BDF-TO-DISPLAYFONT-FILES +51670 . 56008)) (56010 57596 (WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 56010 . 57596))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 927778eaf9838aafa5ba0d1b7cc9d57d42e6156d..9fd699bcf7f9f5751c2edbca2774d4593cd6ef00 100644 GIT binary patch literal 27572 zcmeHwd3@Z}b?@)@o6%}{JeJ2o7D673EQI0_wgF=ZH5$$Q>=|ihenK;{Eiee#Rv5`+ z+0P3JO>kwvEI~1rjbR21q>vWckVX;@@IK88FNtb+A&J?VE=ee)bam?2w0$jczvrC$ zo5f2?($~-D{qb1lo_p@O%kM7do_o%@S7TcF>OjOB*tBu;U}|8CchmN5o40TCerD4a z@77J*x2zlReg=5&=Y#RiyKhKt+BmRmWB;~o%fiFk2DYRIw{BjxabSIF;I3r^Z{Iqw zW$UtT(;xJ;2bZ^g`l@Ry;{|1`+cMCS3m08~^>vlY z{qcxYWs|KMSU)_lb$$O`3y{N$90MEIqJflcfy#Hy!pbvGr5`gc+oa*2J90nM2%0%l zXLJQc+?t`M_m8@kha+YHElilfh!rrj^dqD0mUzM+3;Mf*zHqFoC()7~buaR6+qBu2 z8n|;HMP0GcKoRLZqvgwcVu3{1ilz7IBgQ2t&>b|FhhwIX%0>3&mK!BHtu8ZWOhblJ zt0#dXO955{!`&ulHfq!R2vgSO4|MuhnCX2b>AjeGX)G^u$fXF>>iqCnxT6Qg!C)E~`6{9xb;AAw4>yy(b(AQbAo-Je)wb z%T{$Gq#^PpEMF8oVfF@5LB!v?+=?amThjY3MtRf1$kYu?w-rr~8e!B{+8$1{M^Hr- zfT+JqIx`mync)>7q)wC6RpDSFlpd{YkKj||A%76nmm|9Zo$Xd6h-7M9w;7L{h)fHF z{M~UgL7kZ%EmI9kW9ZPfpcxNzhr1G1cY3sh5a^Y14!bRYB|Ly=WH{lEgabfCq&dz= zcO2~~#m9zw@F`{8=8B$(pGrvttQaWEdlFVOU{M1rZ1BeP=q&E5c%nPpX;M8j&cI5i z5u%kaF@F@;*#%h6)=C8E#tIsZguk7#@|f)zb+-HCW~GiMeLl85mAYHQG}bQ7&tRUp zJdLvqUL=zk^J4K?Q*$e&WE?ajbvI^Y8RlCTdc$!sB31T0Ko7@DfvBM71~L8Pv>bBN z#HgVui8-`?v=SfN6G-%6JTNQEX_oM3U{3P<+dEpaBGTIx%CsZdxjM2u2#9l5tn_z> z=_@H?Wz@e~jU-b}Lp%`*#|Xy=cg(`{=?ceIvEP8A~v_fzZqS(Qu>}LBRCI!#86wW4iljOjTC;+_nvKV_TabD42i8^`dp`SY%Y&L(2RtmSad;J$+Dh&1z9SYDBrC!uo%N2!^h>@(NMH( z&t9-`uI-a7Z4iRtVDN)x087BU9&nYp(jRG~Wk~az(ol84>gpwSvmZ+h=s2br;Iepc zJYxBS3dDj+fGBgDq?S_>m4jp_&zpS)hH)kp;4@<@!`)Uair$ZBrWJB2uEj~yRuzLO z>Zc`=xp5j{9yQXVp7ZS+`$w<+HMb^SaY0^jg9WRN5gg~AR4pT>m(VK9=GP}fyguDp zdbAq6Tb7O2UN8Ao=~$Mz;R^J@#q)D3%cr{DN1vJK?K0C?U8U&Qgc+^E2I2w#^K}s$ z4AL}_Flo(VYW)BCDu z)B+j}W0w_V>^VYLc9Dy+%eeG#h7 z+)e+c_ZgXc&__E_TJgWAq!ukVy5gAtdTn~t-zj?)%_f?=RlquPtJ6s~A z#42pJRx_e9YGPFeu&v07t)%&7b|=E7ESAzZZ%<5H8qC9Gf?vc5Ws;yGD_5cqEn#4# zyk1dM#zcF|?V%hQAx62}hiS`SxChOxv}c8{3xz&1ItTN`-xEpXM-W^|#sFVT>yCG4 z`Qj06gh#8CiyIq3{!$DpK6E6r1BI8NGSwaXgk~?%kXVoy$^4e0P~D^`_Kk31zbnBA zXj~|zxC0gGqZ&pX<&{zUR+!zIA(`$)rs>F3)X6H({-WaVQMRcst53hEOzF3^O$$BR4febY!C%)qXI>!0Izstw84ao+>RL)@?kYCkNb%I zSX~KhYB!tR@tGi*l_#;=42h!%pKHJ4qD-KQIgzHmV-LOqeW&l?#x>|Kmn9D-58c~; zaPUwbb2xeA-u}abNAj4X$z%8SA00eqV@igO@9aNr$EGFwT-juwJNrOCfI$ESDb+~v zP)apYJcTJWNU5ci8l=<~rqm&&o>JeycU)(XyQgJ3K}swJq#QQ=PS%32O3qvep8ET0Au< zR?VqBwVH9y8T_N>)pU%jv#HbU#jIpjOd)X?goSJv(E=t+u{;kzOfg`BWJv5krO~5cIeZ%ia-2>qL-Iz{SQR1 z8F|r*CkAz^Vq7G5Wjc=aW26<%upVeEcj=bdLOS#{Rf}08xchC!;8xq-!?8=|Tb;T}7bV z1phlFoKX=t_&|{v}^=Zt^L@vLeF&141=8xtWP6*_%iXZuR27{$cOn@cO|!2iI@!Pq7$w zN9wN4$yRT8cwK7y`hl%bf^Hn}-r1kp4tQOEYTfn}>o7?_%8JUt;XAyA$_d&>{!PC6 zn>jH}pLVvGrqkK+{9;=0lZ$Co*+=-_=6LnIP)^L`;B{F&Z$Q`r(;}v4?^7QuVe1#n zV1I34t0H-v1gu^C#|IJEWkKk2LwurIZCoY0agS z4fQR|-rJ8K`wM|tOqj)mn5zkMbs=U6VV2m!+fowVmMYM2;_X+WT4gpV&N7VTv2e3xg?n-H?{`wC6Aw;2C6|GvY&@AB_^prl$^J*AoNVrfM<%$XM^KOPN6>)rS0bWbRV*TkYFDr0 zPkmoRLOn1m6P%ubV5B(Hg+xN?tO9PNi*WLxA$;hkU_c@O>aCwp0IdHc0-!4|0MdaQ zZLqoFx$++l1(5$tJ!6vm=OX#cRPvvxm1Z}rS})o=_})>s+8|$q)dfl^)&3kdFQoCbW1+ExKHHWV^;=PH zDPsyn#tIf0rGHpr#DMZ#({GavSR_V0iriJ4JKueZu&;F+C^qiqo^y@Y5L=n7nGNH_1 z`l4Z0v;#%7i99XogY7AxXg^a#+XLE}T<%%ZLs8#RM7{ES)HHPzb#jE;tcGh9sAahF z(@GHz78Sc1gw@g+XH7XpK2%h0FUV&z`FW?aS%L=c%TvovARU}_SKw# z^K0qe{_lx{5U^@Vc*^VEfT<%)UN8ivo-lbW954-p`6MDDXd8+4ze*nmk*?Ji=~{Cl zU8{(6ts>7UU0f?mb7^wH(AarIv#vr_^%#t!Js_X7Dol zE=f>|(~(#u+XO+vtpJrUKLU{7AP_lgdjO_jbKqExFCbR94Xi#ZPI^ImQvg`JB><6Q z{q}}Xh_lz2HiH%qSWHC>Fip4zr0E>D0lPu=xPq3J$XGF|PvzVtpZZDk8O3d5+|B{#|a=pH} zSg>PV=~;5!^RqJM^b78VCyV@L-b#L4FTv1s+(H3B;!yWn;Ia3=)5BftFAMP;p z-e)HqcMlyNIx=*0_{^DOOmX~nYW>_k7tZ^Z3+Oixx}g$Cok=;~-SF;Dc-%P=+5pQ1 zerVvZ3q&yiPPT3$aKnV55y8173?ZG&Hl#%$BMs>c$RtA=f_AooO?I~Tc}l54Q*|3o zf~*tT0ZU=(p(U`q*1XeuE$>ci-jN8!Rayhl&9l5no43>Q9v#29UApzrc9ilke`&jP zU@}?P=S9{q_7BoCSdILJdndGetwx;?^Q*a6QxuHrxQkf`V~; zugylS=8sR0MR!`w$6{9V>9H7~;~mz5lYNU1cUrBd$2xaftw$o(!qa1soz}vmR!b9o zM5BSWOq}_gk*${oJcUad?kBxh*I?MZJ#~bKzFFMSd z9sjAyHKn0f3rS~VXuNM)H3hUEDq4)GGus(CiLvOgYED}98`wDlLu3=w;v^eJ@uae$ zP9v)r*}p8W-Ff4dSMQrA-BrWAXm?#BdQ{+A?$x0otJbQvan;b{3|TFw$A)%VEhi&3 z+H=xs;-Xc+(v6%bWf<|{&2L)O^fhjR8VPD3NL5yff~^*v(A8Gs$-Wkvon8YUF>$8T z@=PY|xl_|OkDAnB$E!gygsDU=@}fm*ilIgGq(u^()1vVPtR9rJ;pC82v*9iDr?j_> z<}-TIodkD})@hnk8RAOd{>NT6qs{;rWEyNT(zC*6b^AoC0s~AFnQ5(+2YEB9ZBC6{rD;jvpZ}-2UL@7%(aRKRE3T0*@g{Tn8!kd?rZ2 z9tlPySS7*2e5Ow^_`isBHYXatkl?Q*_%jKd1WPLC_Iww2~P50n> zZ_y;W-n%3ITd@9W+O6=6wMl5!QA%?`wm`CfOaD4J279*-Y@$jS^0qcVuMA$u zp($-2{{LbT$^gnJMmd3U7NX2CvoN}RI zBh=^}=MXlD^0>knZE{+`vO_jgY6sC`ZtWj$>^ldKs$cE0-V;e>~k)=Ev z*8M3%(tTk==RT0}V4-@Ss6kE6I!b{C6L^h=0N7mqMsPgek5lZ4#`Y?)w* z)9SZy4}3tNu;>#6vPEA15rNJOm8N|~f~Qb%&a;~EyE*?ypO+vhL5~D0KrHUq(?Dv7 zHk^)RI`KW*hnq_Im^1t}foUYE!J+6wRG~d=cOt?=xsCu*PLe~Z8tjFc;M`1LW+qUA zd`1-jmP?%jCR^Gp7Z@w}Q|WzJ z#2ZeEi000QN#y1TWQ=6p2uawGcsz5m5ia;>)HpW&RHtz`+=2Gd0nWXmJrE}mg62M1 zR*{?B)ye`9D-PFjay`SjY}83~xm8NzrTrZ9(i!o`6BMCEFl$YiPJ)q0!Olc!KgdKW zc#3Dt)E78-U9Uur*-nRDuUrP;jSOc;(Caj4`acn9VEeJu?$bUnbo%)X>VTFUxXi$@ zDG7hFBs|FS{TL$7-&eiQsvf^cV9#F5vn#~=0Hr;_oQpdp+r~j(^6<>7gT6VW+Mu0fNzkw>JFN2QU+(8Rt5G`RsnF*n&OO~wQozev?`cHy$I zdkRi)R*h<}hQ{fAwL*c;;Nhs>Yt`Rx)$tfSX4UB%&zu@bK8*(GeU!9w;~AW2tU4~@ zsiCk{_x>wZUFysSubdf4PF~A#oJtsl^UMaT-fDO?+eWBbC3Se}kYLqwwNS%h^5a`; zAmk6yI8|pSelgw#!P}ZyY$|nt^N^3a+>d~q+5}}d_9VJv5#dV&)if7>LYyUcrGzlg z$do2fWI$%c*MY8VO>`ys?NZX!84g5}1K>Cxq8 zYGC64JYY9{#+&OtZ}X1$738KdylI=aKj&J%0C9+z+qS^>Lg3B)+mgfm8wXmcw7Kcg z>n>c{`b`5{hcDme9r)bfR@AnIir+qrn`!I&*QU4t?FZ@6CAo3^m8u_3k1ojP+!6Qw z2esi!Qf>Zgb03PkblY0Nyt;&WX_K<@f4_kFKvLpGimhPvp`pVa#N)>s!#0}J_-9D` z=b8@TP`>*eTdZpFDnN}YX^eNZVC2K&1bC^o-ZKNK=<){k@;YxH9g<2GV;F{96| zlS;r%%p44Z*mxoqC?E4d7yp(2a{C4wS+hNC8^)!!^3`SNy_`yPHV~c zc*0z4U_)QB*IFXt{V~fmxinQ~x&Cv-(Ee1-1y%ni3#x|BtNK*hs^(7yZ-1Nt>e#vs z`~^uL^=U&cqAWaNrjwqEGHkgdkfN*tg|^_u_1$WcSc?R$5-gVB>giCgurvKl^+hw7 zg<;}j6<{)k$Qrj2zu}o^Mp&LfEz}HVWkEqYJbOcjlgPu3_5i?lcLY(QyxZdl~4)f$)nwm)$PRX#e|c} zx`l4CJ!nF13i!cbw=bc<0g?HKdUDm9GOsXL{}Yvp3p zq!Tb>=gH?2$h)b*ptOg!oPB(xUR!0tk%rsI?f4Rd?FTa5ib*=Y59Kj07~X&oIoz?~&&Dl7b)eh(@CQBoLz|aXEB^gUx-OFo*9Z^6Zm3` zDi_7ia}ex>Z~v}zR{xH?)|=6 z%XP`v_#CL>U3Ju5HAU6XW{7@2!QaMRoE^W4`=pQ0AgMD^NDXJ6IqP%2gdU0HdxZ8@ zHw5rCWcjhG(SI1=cnCPyhj7!us(wZ0VSXC%DCeUL<)gfj_IYsPt$7t?z~WJz9e;r= zI%JRD$ht9Fh(bEqvfY-$?+7S0O?Bk0(# z6*V_vH#hQM-rUHq+T5d|NGB;BAhLB&hb~*`*qq9+Knq|0Rn=y7$m9^0%8v<5g3mZ{ zhmE#K$2#UEmlDWl4}-xDkj#`V(iiN(?PpS-#fgYDcS2Okt)U`~LtILT!2g~r&|m`q z(;81QHcSK}a8fl!9NUcC_@~&FTpk~-#EXDU4)<}+4iM-!=D~&Z4Xga!tRs7!GZM9U zjvBKG{4$Y{9oph-mkN`=l(lWfrB^U=HoI0Dks4%h+=dK}fSLAJ4s=CbKia&8-xV2v0C zK9t}npW?K8n0n6bnc&Jypo1f&H=^5e40q?*t0&<+kiD&J=U7LpSCdd-++QDsGk>i@xux?RtJ@j)s zcEFkKZSTL*24>+GzDZkN9bP%`$&G?=%)XcJ<0Aw{LJr2V0pgU7L7{gY#JLrZKLp}T zD9TTx0~zua%J{6wA@r9REI`PPzUBaq%5?*u+uT3A9#^%`_Y?r@4Yd=@dw82{GoW#5 zGYsgQI@G44{eFjjM6_%$A3qh*kA;uR$!b!(UnRm!l=l#<)$tWz;m}jL_F67=KAW7~ zDQxi6<2a#_;-7Y*$xFCyV7RuTLPk2HD2h%omTOK{PJoA`RW~#Bp3z*(j!vBE3mL>B zXh?1?$B$wYQ1MkYHb(t{Zc+ty<7JImcC_HK|1@ONj$_(51HmB8c8xn#=LPgNE_5wn zf0sa=*0=TugC7#Oi$Lu;o{IX1Z4$eRCLxx~Dyuu#)yTwC7fIl}n-$MJnX9rd1(}9uO(v5C_&o z`Y|0X*Bi;OcCb*t$&G9Q*gi7=3tW|6w9F*wE(W-%|d~ znck3E#TZ5RSQ`xr<%Cs=+H6j@}!!G*l4bge{9vn(ddSg z$Hw356!{Eg)D^f3&D2Xp=*{QLLmgtVLl)c(!EZyB`hthYqlG+%oESqsy#B+N5nE`4 z;G5i%Nt6}q@=CxZNKr*IMPm;-xRkbAcz}XtP$ii240AP3FtDTZME8p>=D?Vhgr*@oF0W3Ne)*mW2W*!4LaVdz zBH9(25;Zl~)vI%5FcTugUDv59uB3kNgkufNA~x-5m^-Tx=bAx@o3B$OB z0y{|PPHjHMHDG>DINWwY$P3vnmp2-k^62!vuB?dBle33HQ)EAR7(vRgMQKmIR2SXQ zoiL88&Tt8nm@vMUFLhR)+JmJvVT@fM&55+_7f7o_TJHtYs*v^@7f5pk9Y>3Y`qrT&v&v55 zE`#`W7B13Gdy#hfc$AJsqI0sc4ILhTK5Sq}jO>?+`xw>3UdH4pgS(wZ&Yit}vY^8a z%)JR+PG6kC&8+~gs_^6f-u}4SEbXbid&A@Pp{ZJ#1cZUrA7=U5VzYd$47NSIsvByL zMsWVbHvVYGG4ugabB(LXs-vXLF)H}BvDgD>7$3AA2OtX8X8;*G(r~im>4-QC9($AH zp8~|+Jn0Qh)gki!E64E*u?U;^2JGUmVm{Z<0p)l!mg~dFhPSYL4}}d(_eXLczMq(7 zX?Eh@*2DHVxoVYLb+D|TDJ`j5Yk%OBaVV@SWR(hCDs-x_RE6c!bDg6w#)T+I*IjQ3hvGM_Eip^PR@ zms5&VwOa|i_~l!)WYJZN$U(^YJ1B1&oEtB*V!47G(}H zRsmDXH-eO@pWiy87i3I7p98{_g&&fNgk!V=={Mx+);`FPIIX>txru_`18Hfzr#)_R z^nkQxI|pT(k?7`f_#G^%?KV!^6{bMj6Ob6oRr-l5kzrOGPsQPhC)GASvarvWvCG56 z4_1K6NyRp!2>Gb_rHX&?Uh#36@CEDnXM34HDqx0xGjYVt8)= zF~?6ZA8xJFLq4E4UK2DuGBg8L>27{Y&3-fp1p2=+ zfqsg6f|aFzE|`;yp&z(&P~G}L#<1%2dBJc`Ypg+4wzCnYd5p+63C(({nwnem91juT zMI;JDNZCu^e8y=1z=b>t3@$YijrI)*UO`#xAed<8pV>CxdB3}tdMTi(BMFm;!} z@xk95!0~H2UZEj`w`=fo11W(v4Juso`hj(Wn<={WiXHP;4Gi9qWa1t3T;;l?7j9{E!@GG$@Cq(4ogNMT3I+bs#@%U~>6nWu zR;o=^Gapo2z?4QCAK3VB*;^N}UXrgSmjRfnqBGm%qT)n%cJdNR6b&WqP1xWNrQPZN z?cXf$j?iW)jcaJa?oA=V3)#S-vhRa7Ibz4mB&^i${Q z`;Gl6dTJBTA;IsT-s$S)SwX|4?Zl~Fo%Zldp|RV$y8?>s>EuP4d(%s!25i7sKtMED zCWK^?JEge-se%4s-}cS?p66C*$@w(P8^Q=K?2?fIzAL6q?`W3z+o7$}s6_qh^eA3C z6~D-W$(w)n>U?t-uc(qGdrSZD9b!`+rBfU@5sVOIy_D;i$~uXYhFsCS22Vwur>c$H zVX0m_a0lLy`t0Dgq?czsF^Ja7;cSqLp+oHASsil+&XjKTq#xe@6vrIuqZ^Qrb9K6! zzHz4XnrIwCQw^%ucn}Yq-BpZz8t!6L)-&8m+DUmFlIqpjc5A#qr|nAHp=!~R1DPIF zveiDTJ~{xQI=w;3Z`pwj?+u-LA!W!(^&y$Hbav%&Y_n%E&vMq__A03o(-~4FPwERD z{W3j9@mUWVp{m^GN!M1X)!#txsaG1E5&pFMf}HSURsw3z$$67TqzC$c2ha+6YDR^H^7*Q3OyewAepEY3Yx zqyxyr*+?Ac^aE!jagNg;P{_$otD4|qK<_;9H$a8g$Im^fn4#0r*N!0OK?$ZR0q$N4 z>6VSUf}t)SXzZZCS-t}|1$g?U+C0u|c{!jf8jY~QEI>YM zUdsIzAmnR-?XM*ZvrH4xTIeI1foX`e+*Mm;j^!Pye`j;eQ}J$R`B`|?WM zAS+O^P9vW$CF?883>#Ul2di-S+sRO3yi9N;$WrVd0Cu+biudtTNFdiD9HksH=t&_uCy=LsoCN+>5>|5^epF%HM4~~rKNwz(nEpOC zIQ5 z+~7#Kt)r7As-{Dodq#G3k|W-Ukl{|YK|;q`Uxm931+H@Zpkk>UxbIJ3A(!*R?YP4w zmZwX7)ZxZl9%1AAGdXr?2@jXiBFxdxqSg9R6hEp}f zw#Pyb+71)OLAcS0d5tMUJX?5_89La3%Q2VQ)J_{HwSjUBecj5>g&dwBHQmy2Dy;eWe77BNCMxvH$IxFHul==iNiaKqd=;fE{ z;2$BzR`R^FH(T0L>#&RRwN1HOIW~U1y6ReEHS;L?`4QKl$ ztFcip!5UjVyZ8)%TO+wUM0f}tZ?fahGcY6jF8%6hhQEhZBsYri5SD#61vqtW1<(bq zR3gPC&$Zh(Q-C?&4I`l0%0tiU#>rM>d;{Cc`Tptvr5)w9K0x5BAe$~%g&-Oz|7zm} zZv00?a36zYVl|SS?MDQP_XU?A9OlP_WdVTAu?D>wj?)oLU2*wq6_kDv7w{8+`i~f- z?OOjK-xShcWef`i%%J2p5wjzmO4pesu{0oOL-9@jSNeeYCJw*7@LP+mh>${1`)w*r zKT*zQR*;NiJjbY01Rg*hW{(tkj3Vt;u$Lmj8vla85a;~>psk1d1J($_?VhU8ACUmh zHB)S(1nVWZMS|<72x+lTFqeovZNCKKBk`x3xu!o^%fSy59Q?5;Lf%`-v3FZIc&DBM z?RzY*=xORb_6Kdr-D18~EJ-V2NWZeUYK2}MTrbnCY{cY=J=;S^#xUPR2 zRBohmxSn=6o=&+tPX7QtU)Lr!ji-m&z%Jczr=VbvF4v*7RR6}c>-%YY{^fsU03X5I zeO`}l1mZwav$QAiCop0~p8DA3rN*9%q*GN-3m-~qwW9)>#Z#2U~p&uBpgiUAOF6~zwhzd zor}eD{=Zj3GmYK{KHuLsp)?+Ug9_39O|A<5kjs6ISxau|x{2VYvRuB;Ye;)df|n(D zUV{A+d`SYB1wNZGhcbaxnZPGlNO-#F0#lA%I6lR@2LJG8B>PVu$q*xH5zK=h2Mj0j zr+f;$SG@CB7X#hjJbaSv%`rc7gFACWi5CpKN-5bmC;ioxayqTiowS9<>!_UjhfZd;()ErkHtbIx4Z zPHA_)uOC6@%$a}AoO#@TUViiy_WOTehc@;$uP96IzIo5qKF_v+9etjyd-{5B>buV4 zS>=uG-s@f7wEPOs@)hfvo7P>?T-K^3BNxL`{WtHq@w(pImU>os0N=NBOWz(37Fs%4 z>O{Vb&9meV4cmg^b1ro8sP99!mv+ z$(Dp3PjM(I&RZ9P+XY2c4G5bZ*IL?J^++(LMT3pWR08~w`^o5_$flyYB?vB~h}$AP z@epBVCgTx3MOApQJQ=AiDwO)~q7>^Ax~*%$RpmLsa`&sbVdr1#P?5K-QJYtYcWpb^ zTCuJ8#*A-a?%=QkqUmT!btHmb?hglBQk8~}89qx*PS|t8V)&HYk>TPv*JG(*f()v$ zm!#E{Hmvi=u+^`plEsu$V&;^Y(r(HMQ#wdy3}2;baGJ8p*gF^MHTL3vIiVW2gR6`G zgBq$KY&D)Ve9&1lqFQ?phnM;X2geRp>tsJ!llnEX$IAV@BNl*;_w#P*!c18-2qV#w zl%onAA5ZXjFp<)ONdnlCU3wrT2f-GY(u<|NnLx!d!%TE`LJ#5ufFNu%gwmBY8R@_g zKR8?x&{A5eCmzgtvbkZ4ztsz)X6#cGWj~I6p(WlpjP0J%WtsI^B}+qLBhbBB@L`iP zC~MpTMT)_N*<2wppF@l_q9;>X<5m-4c7ur+&XThSv&L?#pOVW63pgvr z(QgYT6g6wy0VQTYiHkbVEO21b@25=EMO|v54rYh4#+?8t1vis@Y-S$9%#4{C=*pNQ zVCIfsE_PNH5M`6avG+~H;R0gFL`;p3i4X)U&AmfYg^z z{U=giL{*S_<~9RDL2J;@KHs;YP2!rF``9t@ z>dX~oKb>v(W*9yzw886gLmSpQmY4ciIeB>kC}**Fz~RrVz0CN8-PmJWYuvcfxM`W8 zEi`VfG&E*tNH-4T4o#6%pqVVAnJlB(OuNY~n#nDi$t{}6Et=#OLo=yGGpR)bYROOq z)utntDQisWChmda|M!2$Kh&&y3=QWG@lS!Qg@dy0g^ZG5tc4@p80*P)(AbxOt~*4D z5&At$zXHG(zrTw(0~Ek0JBR+f0Y&x^Xn7hM4T@m{xDU~)X1Bl z_Y0smr-KSJ!UTO#0KEkuvlAz0io|4;4kO(P zgZglm{1X0Gh-I^u8XERzXOZ~6oWMV@%r$^Ika`N__KqYs_Mtdrzk2-2s%IH{N3iNS z%@b7cIoMQAebZRS3uHe{zh~(8Mf!b7v{mmUa%M?1uyy#Ok-8SuWu&e_^%7E7qiP{_ z6{yN@NWB78s)VgX^)a%pK=lDqm!mp_s`AqHBwmb?IJ4SVh}P4R&0iokXU!M0IkSn* zd0%C=!>;+2uUhNKPfR2;&&Kg9tZr8j3GXiW5 zY}sIBOImm=nbLrPZZHCn+aTVryR4?In5qb=GmRjFe+VXvZUlw4sHh0^Cf4~O;5D*rRPT4hxpR(M0n%5k;o8lJjEO8 zu@$wYDnxVQ!mZpb&MdCYRObh=LGE3Qof{c*@@nor9saQb7U&gse(ViiA>&fgH5WnW z@EU+}=QQl=CYIMYt@-xI*|aMk=FYR+wY?nsBVCm*0IHle=oNRqKLasg*Yr~tK}Wcu zi>QYT?q+F^th;Vpjn zza4E46L`y361^!S(kQh{Ak*?V6evyv;}NZe+9COBD`p*qtRg)Y@1Wpe2aU!76dA?R zBa}^_KtSvBn zvtV0)s%bMD9>1hH!)EJP&nUS}-$7!F_~!E3xx?t`9Wop}X0)5j>9gYWHrFbJzLajY zhdrUI*RoUX>L&J7R83bf{0b}7bfubhGUO7c%F@+&BHXa}h0mFJB64!|j^fB5eN)5` zF98MZ=;f|+BmMVq*N)pkW(SUd=6QLDyUtMA`D(U5?K;d|pQdl_R1BTO{thRZXVoKp&KTs?rO0K~pviE&52%jM!#qr7Sw68k}L*H{&=KFq7{^GT9bf%th1!va7; z?K5HMrX5P*76Rs!9S1b?MWBKialHHTnzsOG#`AXxoGkPR9&vC!v72bQNx z3PSeIM4#gZZuD3Vwq^EkN37k8^wbp$pm7)B9z<2gnVkr>bwo6zGUkJ{75oyenQ#w* zUHK5~rTEQiEpX3;mfyz^{mZC63_x2n7|=VSd!)4!qAkLrAKL)ISX04dYL4N9 z^L!EDS#3@f!3EiYgmi~$Y)bW$`X#g`kKlDuCiy8f6oc4c~8V1 z`U`hD1f-|5h~9!3d@_a69)&a36#Ofw(iRcEcu-{^q)rPYFcnh-2qU7mT^dTYAMljG z#bRvtO`cv);gV{d=g#Dvi(qdS8DDnw&n!S*c7HX|*)qEes<+53s}P(0RWsOew8*J& zT-@bfn2{DqxdJlP$EoJ0QGJwDETYPlhE%zZd>5@prvOP9lA;uBI$JP9?yiY8|A#PX zu(D5+`V6Xc!e!6wy9V?o7&~j1mWV-y^86%Rc?|6GXs;y_#EHs-2*sT(mo>|7IxboI z_+@1L7Z-_V#VsxCGVBoy=bL2tKB`|M^#`avNa_z!9U*lB)nQVx7@Lqw3oVQa+bEZo z*QGc`Q(xH!v(2H$^pvheybxFlj`_*WhSq8L!q6jSr5!0w=eqS`QDA|}o)fKsq{>c< z2Le8JK>RGQXbpP?noX6S#`*AInSlpQCG>&Ql^=lL8u62mE5jh5(j|DEueAl27%>&P%_L4sZrB>v z;Jz4YV_mu7;?7{g&yzv*X2aG6#q6zmEZ{YZT6e?f$$ikEQPPKAC)sB+a#}DFjKY9= zar0oo`0vMd)GCU#fkF>WxG4JTAT)cP)`3IWd%-G}h8HrIh==FS?wt;*%zx>GB_eJQ zH?W1`%i+b9vqKXlv>1dYDxp_SsJ|6&hBs8^O!pOX6MI7atk~5)w@3xRcF^WCPU$j8 zuOQ71+Fa5q@+a7N@gMCjmAyuWN-%s+R7KW9K%J4#E>zwtI1f!YXdTO+P+kvB*s1H^ z`qBwy;&61sypge8VF(@KqZqJ>Rrx1F6IG%=dUa-WD()(7rt9r;0DMV^ul#ZoT56I+tGp`5|0inHNB;kp+dAyV*FdYhY9tge9^ zYb}g?d8ZcX2qwLFV~@7kFu992Mmx>43M7x7D`|z^QtWgb!uW@*lLpwc2!6J|QcqUm6YfxS^ zxOkgaXV@|6>HH0Vb`ZKX0WFkI6d%W0R7FRj>~E1N`3?6jg95XYdNdvhnrLruLx&bw zAW=>dmQp}j(Jd_~ZxZ!cz6!gKVmQ9E@(kW{f^*BT%n1`kT42|T75^*XXlaI57)+la zGkX`zGvS6JLEGlSiw^+UuO;ABiWfVFJufZaCCg#7j7bYEOG;)0P4`RFegYjr%dOHv zdmH5-S~g0{2CN%*R~NmwAiyU9SCEs>p#`4eKq#+~d;<>L4#A^oz}phx zNqC_|$Cp7y>Be{}5rR$MN(^W}oHQzdE{H=y6E(yu^0h^s3s;nKfx}NQ%j^`+JUB(6 zFPEYu@C`1|s-h!Woz#W6wp5fAs%Tzy3}*WF&Rc=^{u7Ol<=Gtc4!o79ce#)VXoT6fHdj~8`27<+!as%J=Lagn=rLx#vAP0hfK zyGm_f#1*u$QD>o*f>#w(iwOGww)^cVl`cWqX0R%68F=b8uP|wr(Dp&WbEfh`DneHJ zd@?FS^D#1Gt%_u*^Qhi~R#p8J358mtywge04`r8sxLl?@QdCIM2*u=$f@0Yu=|GpF zMT&YUJchOwp-!2E+h9z|!@PRc&J^Mq87b=^3-L@yV&pD~Xl8}9Tuzun_@2bv(o{tz z;u(c3$~$EFGx|RxEssM4rNnxZjZ(gWDD@I<_#{QY^fAM?no7QSx#3$x+L?KVk8Y5a z)5Z8Ii7sEjy9^Qi__xb9z}I&xt(iVNu8X>KI`5eMo)G}%)c>}g(cvYRh~qWyR|-6Y*zJErp{hK73HIL#lgrv!yjaNYP(*G($; z8+)uDufg5C7Mv{MOY2w>&~##+_|2AvSrah6wpJ~wM|x<6{YbdCUTUXJu^0Y8BbhrS z-fWyFy0$iC=HQ%d2bP}QmC*6HozUBZxEkVL*kB$lLG0(KY5<$Dv5<++lW3K^kwI0G zMjBK}XzE5(e@Al=J+L=WRX3rUC##LX-w?B|o1I_}Q7+!8vK^F*)Wxo++c_p@FkRc3 zYXoMR>jbJ5w3VaBF@+H=zA0|MZhoe>gxoH307#Wz$7fKjht|;7gb5EO{5;Tuo`_^s zWMFoN%Az;65>-jPN94|7A7%F3K%#pKi7q;ntDSP??pR}73#HW563R^0piq89{iG&} zF>7sZxZJ!g#GVBcd+nnpKv@%7mlw0))to8l=RNUQ-!k@w_*Gv5b^>d*HQRql)hrx^ zPxo?hslzGW?$@nr9mZO5^}waf|i7SFO6l^^}Ht|IueE~9Gv zGPR6#D(K5j)0`%+L&*(0nmsq|zQMbrZ*SiY&$iurc0w%X10l0PN0z{aG~S^m6$XEp UVKJ^U`oOBjxI*jV=!Faa3!C|DXaE2J diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index 891c14cc161b6a178923a02d5d7af4e2a55e0467..04bd3f932e92dfafeb1c9b0836adbbf3eff355a0 100644 GIT binary patch literal 22202 zcmeHPTXP%9bskDuC&D^$634kYm$ud`gEomJsXMEjG6)W(u|NO@KKaeU{QkCcYg#3iOrSjqjzxp4zD&;CyrSj&t&G((YU_g)(6sNS@HMJr*IMaRl z^tqqYt=*6Mqv-Tz+pq4f@9gfCwo0YDrP5}pQwP(OSx z98FJ>xY7$plc+bWME&V%sXL5w)lYlVlPH;}QJ7Cu)Q=}oUtwk=eG#1;MVZ=sw5GN; zw(eC*L8IGl?jF>-L9?MJpQQciC{q1s5GPTt2GgWBiPI!klT>9<*jFG{4bto+oZuH0 z8N{O~UsGYySCe6saNNrbOR6Zw_e|~kyLJC?H|VtL)x*7JqpQ+P6~77s)dQ|DPU7U4 zXw>oObUeiJS$ZPh^K_c^BE2{ktf(MS38@&VX&$X{Odb^oQZM7tNDadm5vV>1$78VI z9K3O+4wAT+_CaofU$T6v_C+|~%GG|Y)^TqtstTM*^m25ndf)}wnxCE=rK4QM*f@D_ z*cWDz25FMVVeff(45~|e2Mu9%r&P9rR;_CHiMsvNKUCY#{Ps?>yALU7gKHexr*0J4Oy5G>YQQ_}>hmKT`= z+)0|OH-h>ahrS%fy`k!bP=$D+RluNv{zGa74KPE~EQ|7SO65&Sd)(JD?+wE&>`kI9 zuV9yvN-;IVMnE@_>{a)J`r(@T*bg2*>8`0xz1qMp|C3g=(Sa?gN%$PhaO&$M5huWz zKx>7AssZk52908{3S77Yk&HnT>^IbgXIRq-{?4~-qTy*4YiooV=JAhdwY?GO<~%V8 z)e1iG>+3R=0&X>7@cOGG?F>a_?zS)v90p^7I3A}Mnv2vU?OH_EB%drf0>{HF3r}Yo zpfzbeTO%{_B^%8qt%Mg9gp8-|2u?h}&P5+~4ubmbdab$NYIcIIzow3&QTnn1_Z2M| zi_?5fqm!z$Y0J@>fF^k~8kn_vVFK*1jZ>}HD(v;5@gzKgO+jBk5tM8)l>OK0+s&5W zpmz)OW2Xxf-=Dcq7+n=kIigoi6Ywxjrmxg=5|84^sdk#Vvsr9BS3#%w@Zr5jA8oFw zJjE*TxrW=;Lg9%42M}ftn}l*fK*3<92*i}AZ~{}AC-LYM)&O0EZA9_$5Q}w2VS-=OKmXM@)V>6p>yz3O zM4A4~PQ-bc7$a`JTuVoz2qEZ2M9iwzoI&k1_kYXwe_H~xwWSD zU_c03?dBuo(7#3C^g9vQI+E@z;XfuvTHucN6$V5eah*u*%TAX-8tD@Xl- z4#}!)0x(z&r;GJ-j%*>=G^+c)TQ^@tFvU`Cf6$nMzqad8X|zX$K_JRWIFXrvgLm<9 zf`G`W+E;5`W3-%Y+TwC}OcbpsQeeoP5dvyydGLhUDf1V{avA}{6pbhyY@bgqI4Qdp z{)CJBrbenL%dm=QJ+_sF(4MHTU5SW}9?bY(YFC;wv2ijOXK63O-f5}>=xO@WM2p!T zK%XR|nMz5fsnkB61c)ZgTStG)gc5w}?nw_`LUqTXH-BvfeQ2J&*c`*VKBU z-vtL?N}=M2&jTtHMu#J&l^|aSJr@tGK3W~aP{^E=U^z_$K;x5&L(%E&WrLS({HPf42_=fe} zpl$LwohPVmiNM=*M{2v>>{gj?tLFSd0AT zwL|u7b0NvVbDMjctQqb3zTKi$rzzBRmV^r8Zeh(F}5 zD+SW&WIUDB(7F$7@Cc6h)TKF=>g$ z5=iS=|5m8X#j|yO6W6A;Yfq}}^^V`|plYkO)(;v_8_ka!bfm3z@C@drwzYH)8hGFG zcVWlXk1;N&HFy1W!h*)*i(TX*xyCydUYLAH@+;%SBx*96y)$nJb*0OIX)L(I`B;=s zkJkGr$$OKOY0qHh3Xws~>48e7Z0B4~zgghF(IeUamCHne@;Pvs1;e!-78jV&O@lLX9GEVf)aPu*3S1?e#=HZkZ8II&Ucr_OyE(GyhNe27};`~L$1px^pV^UX&B9oQ5)Lt+c=Mmv5R!%0>6ef0&F-} z!}O)isLC^RY&qtuhNI`VLv$*4gxKFtrQAWB&^eSiEyHR!lp&(^2xSY4sQFrdGEAjK zp&d^#p`&n6EWbd_hO#F)cJWJayIyFH&Sjz8f1^0(U7S#K5r4ovvb#)53`ZeDd`pm` zApbcN7BIZHH^j2}wblU8of!0V;pJ7?^qf{*uZO7*lqHm23Azd+Nq*^J3(aZ9MEYvr zx`i;LgVHU<4sybj)r3xy@}OTKsTnsRkzd++rSoE#?8W`$QKH(N})AZPCI?UOChg#uZ| zb)8MBE=u;yy3=Hdl}X?Q12rR;CBx>8kL!o6Cs2FcVsai_oHTP=cn?h$x@7u{0LMve zv}w;_s%Y)^OR7F6dI_o~UDf+DPkmMIe@^Rtqsu(>_yUymXU`&LP0*_o zjH?q2eU^1~f}uNTU+fc%Mzia8N}qn}{rBKg?`9WCroGlP-|H?ULnik|)z#;9gdQ)u zhnv0>%5RH-5(L=~8Hk4lo8{8_d9^^0yazqF3WI<4qrT zVS+W1xzK|-h!usqA#6>^^$sZ$p;h+gkK5LPoQZ|DbuX=BInpxcG&m5$nP)#f#u@#Z zJre~HqqrAO(86Vx+g^%#O`?HnQ;vO896J+T-ophdq{kveyu#m6{2XWMtQ~Rk#@jyV zCG*tWRS98YN`z4=^5+pI`NLwOA7(tA`PlC%i<*0I8L94}wdax%mLLNUo zmMaoyU+Vi5_VQF=Tl%PQ{vgKjOgD$1h3N@$f2qQG2uNDoIS~UkiO>g2!v2|>=Wo(; zRxnHGh(2Y(+4le{kG%_Hc&q~n@`K$L`Bq?(93@bPvAKdV;Ed3(;ZP*-JG3jv!<5x2 zZu3plDa2(8O%b;{+#TVRmnMhnZxNdNkR30SXe-gz)E++3{{{BynB@qcjOH)_5# z$fQZOfnpc`t*UalReh{q;Hl-eO_bqjx2Ri|5R zcX5uwxgV%apdq^Zn_KF^qb(wpnYtg>!qj@R`Lv_TKRBrFs+!-x{X>6uRq-sxyy+Zp zX*t&eqM-3C=ma}B25+Lg@A!3Swp<~T?=2k60)V3(dCO~Tn;X{u?cwJZ34{Y_uU)}KETGivrPjF`!%+%~MU%H1R;-JyM3xY8B z;a&CM?p<|nt2nod+nh2{#EK!0?yI}^?yLJ75H87C#ms75ZhYc!jH6`aZ>9jic_r{m zEb#w>O<#%hGTSiBcvYPFd*1urraYOC>nq+ji{HFK=T>tzOLMB5fZcdc1(wiT`h)T_0pqKg&py~kCISZ?&& zApZmJt!RNz-Ud5VZkY>TIfXJ><_OR@cPMhtE)F2NZYbq;4Vd>PI_39dMEuBk%b-^`gSG0Ba_&(O5t z^xiC{D?f9QnBJ8FFJ(=aN=%oEGw+I+&tEvWR627-%xCRqmQvt%Wlc*tz28b=uEcav zg?OoS=1NRgVruY|U|+n{QnmJ_QsAYCxl~d6QiX$e$eFk4E&b8kwW6+j-j;XsiC=%_ zcZ1qnH{QN1eZSXr_0a2@kY+ox+z$Jf3Bg6?Rm1o zIv$|ip0|ddn|zROX2>;sd;dxMpzc>5``x{Udv6DE#{bVCcHd{2|5lIbcB2bKOP~D73z7X1kK-gaPoxg94B@veJ4qNkrKlq^hC<*3k)gce zho}(OlQBH^vAa@yB-By!XaUl)5SdLP1u>=Cwy)fDw>>uo*_K|yLEz}lEc)0&EL~1$ z4)I^uAr1}MFi*Rah#RwG$2iEJSct>?(E=o}5I1Xg0phgV%IHH5`5Jx%@mK8wHCz}+ zh)9^*m%-$Whz8w0Jx0W96z&56#VpEvAPNyIQG9;^vTq?mF~`VY&JuAGA|^(NmlR>Y5DIaiRE(=$IHhegs+7_hj?*u$1b<6@7Y;S5KhDb;eyVmxG{^XJBXwCyB0I0 zAvDWINv6Z>9FK#zF^+}*V(~1lZuqp~^ppS+pg8AS_z|_gjR#@ehj`!@35vom@V@e^H+EfVbMhhi<+@p?pe{Lavh6mx`pIV4uHTvbaB*G$< zHT(!t2XT7gIMA?T9N(PO9RDweqKRlo%FzPJpRHQ`tEI;pn>Cvib@mMfCkph^z7ZyK zSN~)oB2y|a^+&`fQX|Bvw3`*%F|sD{Y*>h;Mzo3_qD<5a(O^Oxn*XtrL{o@HD3z&3 zy|(QTAp$5?eq|wczq9BsEAV5-jv+Nf{viQZUR7iu%yx1hyS|`aRn);M6L&4oSNV_d zL4pR2YSB4=X88}v5$%)@m@Zucq{xEF^O)YqgLBEwF^MbSBxT2Nrf9odm*I35k6olE z;<*)E3=+>y^^v@avt8tJvn9#mbRm{wKERJ4bY9Fwx7&Q>@DQ`hUKgmC4>X2AJzLTZ zt`}N-qT~E%34Qq+YNgcYR5?NcT>`p8#>pLuS}QXJ#<`5ik(bcpZ&%|c}7#51;# z1uE{_H;%XeVIdq#Msqc9rCgRvL%3|*lq;z{kx Nx4*XXpFjTh{{>7UQ= zo-aG!@!vCFZ1q~3wTBF=dFHXDH|IHS z*2;*Yolm$0I~ur>-mbh;->6ou1`#jQzR!-71kAX6>`VIRg;N&tT2HJSSo8CqFz-TK zb#_ADABZ&4)SU|e}@uCKNFga?299++x5-ux~P^( z4_OXfdi9VwQEGqIQf*z-OYg5&M7dVIA?oj~tHz|y^^L9iypVgLyM6JvQZklyv)+8L z`E@wT__q`VKtew)m? zo?Qs;?Xkz@Jr?j(*GlQe`WA?TLj6`%o|_ik7+O};-tJ8Qj8Ru-{vJ))1uvFz@?x`A z{a|BleNEJ>t!dSQn?KHe$y>cwq7Qhq89MdQ&x6g~)91Oodgc*7F0F+a=d!x+mi%hr zZJ&<;=ow_}CR>)@yz+8?*2zT0$(*`?%90-~PWLdz>TE?h!+~WxQ?xxNX~{p&O&lJI zIyX}X>zwTRKhLy`zIa+bvVR>9s#a*nj;n{mIHsNej4rvdG!^KA$$YF=KDRX9c^c9_ zgi}ht{3ksX=xH30)N(H%iT@&H1;5M$KH>KGI!nqwMise$=PDZDTN)hB&1uc@flXu8vakwmfJ za}c4i5JN)YMCm|uod!FrPDH_s`mRQZBGN`RLObYaW@0Yrm?0R5A!cZ1V$9_*NW%mf zh3+9AX?kYOo(o{@9$L2=g;NMT8et}uBm|xB)zguUi_m})+$=@6G+LN@sb%I*bQ#(f z3Y)2nItd+vddMWX$*lnJR5lq6Hlkzcb3;9&_VaKdeHaGPj7T#F5RzSs)80b;f$nD$ zQLrd!q#O5-mNly(GZsmCXhEa4p-l625Ts84h>`LI-N9_+K4Y&vHP@yN+SkVj#mz;5 b$EU&|mHKP`q!>N=@UM^68p7;{+dKaOF+UP| From a8a427597fadc87d74484492fe3816354f3417a6 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Sun, 30 Nov 2025 17:46:12 -0800 Subject: [PATCH 5/9] Significant restructuring: Removed WRITE-BDF-TO-DISPLAYFONT-FILE (i.e., no STRIKE format files). No multiple-values returned. Instead, use LIST when appropriate. BDF-TO-CHARSETINFO is now IDEMPOTENT w.r.t. the GLYPHS. Move resolution and defaulting of FAMILY, FACE, SIZE, ROTATION, DEVICE from WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE to BDF-TO-FONTDESCRIPTOR. Keep the MCCS chars present BITMAP in the BDF-FONT structure, instead of needing to schlepping it around separately. Abstracted testing/setting the MCCS chars present bits to CHAR-PRESENT-BIT (mimicking BITMAPBIT). Added COUNT-MCHARS to know how many MCCS chars are marked in the BITMAP as present. READ-BDF now handles when UTOMCODE? returns multiple mappings, and creates the appropriate duplicate GLYPHS with different MCCS char codes. READ-GLYPH doesn't create an empty BITMAP for spacing glyphs. Use font code changes: Set (CHARSETINFO CHARSETNO). Set (FONTDESCRIPTOR FONTSLUGWIDTH). --- lispusers/READ-BDF | 1092 +++++++---------- lispusers/READ-BDF.DFASL | Bin 27572 -> 24256 bytes lispusers/READ-BDF.TEDIT | Bin 22202 -> 12137 bytes obsolete/lispusers/READ-BDF-old/READ-BDF | 857 +++++++++++++ .../lispusers/READ-BDF-old/READ-BDF.DFASL | Bin 0 -> 21485 bytes .../lispusers/READ-BDF-old/READ-BDF.TEDIT | Bin 0 -> 9819 bytes 6 files changed, 1327 insertions(+), 622 deletions(-) create mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF create mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL create mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index a6855618c..77bf8c041 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,21 +1,19 @@ (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" "BUILD-COMPOSITE" - "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" -"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" -"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" -"WRITESTRIKEFONTFILE" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10) + "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (IMPORT-FROM "IL" "BITBLT" "BITMAPBIT" "BITMAPCREATE" +"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" +"FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" +"UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10) -(IL:FILECREATED "19-Nov-2025 22:01:49" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;37| 59108 +(IL:FILECREATED "30-Nov-2025 17:43:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;75| 50310 :EDIT-BY "mth" - :CHANGES-TO (FILE-ENVIRONMENTS "READ-BDF") - (IL:FUNCTIONS BUILD-COMPOSITE READ-BDF WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE - WRITE-BDF-TO-DISPLAYFONT-FILES GET-FAMILY-FACE-SIZE-FROM-NAME READ-GLYPH - GET-CHARS-PRESENT) - (IL:STRUCTURES BDF-FONT XLFD) + :CHANGES-TO (IL:FUNCTIONS GLYPHS-BY-CHARSET BDF-TO-FONTDESCRIPTOR + WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE BUILD-COMPOSITE READ-BDF + BDF-TO-CHARSETINFO COUNT-MCHARS) (IL:VARS IL:READ-BDFCOMS) - :PREVIOUS-DATE "18-Nov-2025 21:22:35" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;36| + :PREVIOUS-DATE "30-Nov-2025 16:05:42" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;74| ) @@ -24,10 +22,10 @@ (IL:RPAQQ IL:READ-BDFCOMS ((IL:STRUCTURES BDF-FONT GLYPH XLFD) (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR BUILD-COMPOSITE GET-CHARS-PRESENT - GET-FAMILY-FACE-SIZE-FROM-NAME GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF - READ-DELIMITED-LIST-FROM-STRING READ-GLYPH SPLIT-FONT-NAME - WRITE-BDF-TO-DISPLAYFONT-FILES WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE) + (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR BUILD-COMPOSITE CHAR-PRESENT-BIT + COUNT-MCHARS GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF + READ-DELIMITED-LIST-FROM-STRING READ-GLYPH WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE + XLFD-SPLIT-FONT-NAME XLFD-TO-FACE) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) IL:SYSEDIT) (IL:FILES (IL:LOADCOMP) @@ -44,7 +42,9 @@ (METRICSSET 0 :TYPE (INTEGER 0 2)) (PROPERTIES NIL :TYPE LIST) SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) - (XLFD NIL :TYPE XLFD)) + (UNMAPPED¬GLYPHS NIL :TYPE LIST) + (XLFD NIL :TYPE XLFD) + (MCHAR-PRESENT NIL :TYPE IL:BITMAP)) (DEFSTRUCT GLYPH "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" @@ -61,7 +61,7 @@ (FAMILY NIL :TYPE STRING) (WEIGHT NIL :TYPE STRING) (SLANT NIL :TYPE STRING) - (EXPANSION NIL :TYPE STRING) + (SETWIDTH¬NAME NIL :TYPE STRING) (ADD¬STYLE¬NAME NIL :TYPE STRING) (PIXEL¬SIZE 0 :TYPE INTEGER) (POINT¬SIZE 0 :TYPE INTEGER) @@ -78,81 +78,70 @@ (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) -(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) +(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUGWIDTH) (IL:* IL:\; "Edited 30-Nov-2025 00:12 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 16:37 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 21:18 by mth") + (IL:* IL:\; "Edited 20-Nov-2025 12:19 by mth") (IL:* IL:\; "Edited 15-Nov-2025 14:26 by mth") (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") - (LET (GBCS CSGLYPHS CSLIMITS) + (LET (GBCS CSGLYPHS CSLIMITS SW) (UNLESS (AND (INTEGERP CSET) (<= 0 CSET MAXCHARSET)) (ERROR "Invalid Character set: ~S" CSET) - (IL:* IL:|;;| "Can we get here? I think not!") + (IL:* IL:|;;| "Can we get here? I think not!!") (SETQ CSET 0)) - (SETQ GBCS (COND - ((LISTP FONT) + (COND + ((LISTP FONT) - (IL:* IL:|;;| - "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET") + (IL:* IL:|;;| + "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET") - FONT) - ((BDF-FONT-P FONT) + (SETQ GBCS FONT)) + ((BDF-FONT-P FONT) - (IL:* IL:|;;| - "If passed a BDF-FONT, look only at glyphs in the mapped charsets") + (IL:* IL:|;;| "If passed a BDF-FONT, look only at glyphs in the mapped charsets") - (FIRST (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE))) - (T (ERROR "Invalid FONT: ~S" FONT)))) + (DESTRUCTURING-SETQ (GBCS SW) + (GLYPHS-BY-CHARSET FONT))) + (T (ERROR "Invalid FONT: ~S" FONT))) + (UNLESS (AND (INTEGERP SLUGWIDTH) + (PLUSP SLUGWIDTH)) + (IF (AND (INTEGERP SW) + (PLUSP SW)) + (SETQ SLUGWIDTH SW) + (ERROR "Invalid SLUGWIDTH: ~D" SLUGWIDTH))) (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS))) (LET ((TOTAL-WIDTH 0) (ASCENT 0) (DESCENT 0) (FIRSTCHAR MOST-POSITIVE-FIXNUM) (LASTCHAR MOST-NEGATIVE-FIXNUM) - (CSINFO (IL:|create| CHARSETINFO)) + (CSINFO (IL:|create| CHARSETINFO + IL:CHARSETNO IL:_ CSET)) (IMAGEWIDTHS (IL:\\CREATECSINFOELEMENT)) (DLEFT 0) - SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) - (COND - ((GLYPH-P SLUG-OR-WIDTH) - (SETQ SLUG SLUG-OR-WIDTH) - (SETQ SLUGWIDTH (1+ (GLYPH-WIDTH SLUG))) - (SETQ ASCENT (MAX ASCENT (GLYPH-ASCENT SLUG))) - (SETQ DESCENT (MAX DESCENT (GLYPH-DESCENT SLUG)))) - ((INTEGERP SLUG-OR-WIDTH) - (SETQ SLUGWIDTH SLUG-OR-WIDTH)) - (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH))) - (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL)) - (GL (CDR XGL)) - (GWIDTH (GLYPH-WIDTH - GL)) - (ASC (GLYPH-ASCENT GL)) - (DSC (GLYPH-DESCENT - GL))) + GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) + (LOOP :FOR XGL :IN CSGLYPHS :DO (LET* ((MCODE (CAR XGL)) + (GL (CDR XGL)) + (GWIDTH (GLYPH-WIDTH GL)) + (ASC (GLYPH-ASCENT GL)) + (DSC (GLYPH-DESCENT GL))) (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLYPH-DESCENT calculated by READ-GLYPH will not give a useful value, since it is >= 0. Investigate correcting this.") - (IL:* IL:|;;| -  - "Is the above statement actually true?") - - (SETF (GLYPH-MCODE GL) - MCODE) - (SETQ FIRSTCHAR - (MIN FIRSTCHAR MCODE - )) - (SETQ LASTCHAR - (MAX LASTCHAR MCODE) - ) - (INCF TOTAL-WIDTH GWIDTH) - (SETQ ASCENT - (MAX ASCENT ASC)) - (SETQ DESCENT - (MAX DESCENT DSC)) - GL))) + (IL:* IL:|;;| + "Is the above statement actually true?") + + (SETQ FIRSTCHAR (MIN FIRSTCHAR MCODE)) + (SETQ LASTCHAR (MAX LASTCHAR MCODE)) + (INCF TOTAL-WIDTH GWIDTH) + (SETQ ASCENT (MAX ASCENT ASC)) + (SETQ DESCENT (MAX DESCENT DSC)))) (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT) (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT) (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO)) @@ -182,175 +171,179 @@ (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH) HEIGHT 1)) (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) - (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM - (GLYPH-BITMAP - GL)) + (LOOP :FOR XGL :IN CSGLYPHS :WITH GL :WITH GLBM :WITH GLW :WITH MCODE :DO + (SETQ MCODE (CAR XGL)) + (SETQ GL (CDR XGL)) + (SETQ GLBM (GLYPH-BITMAP GL)) (SETQ GLW (GLYPH-WIDTH GL)) - (SETQ MCODE (GLYPH-MCODE GL)) - (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) - (+ DESCENT (GLYPH-BBYOFF0 GL)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE) + (WHEN GLBM + + (IL:* IL:|;;| "Empty bitmap, nothing to copy.") + + (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) + (+ DESCENT (GLYPH-BBYOFF0 GL)) + (BITMAPWIDTH GLBM) + (BITMAPHEIGHT GLBM) + 'INPUT + 'IL:REPLACE)) (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) (IL:\\FSETOFFSET IMAGEWIDTHS MCODE GLW) (IL:\\FSETOFFSET WIDTHS MCODE (FIRST (GLYPH-DWIDTH GL))) (INCF DLEFT GLW)) - (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") - - (IF SLUG - (LET ((GLBM (GLYPH-BITMAP SLUG))) - (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (MAX 0 (GLYPH-BBXOFF0 SLUG))) - (+ DESCENT (GLYPH-BBYOFF0 SLUG)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE)) - (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH) - 0 - (1- SLUGWIDTH) - (+ ASCENT DESCENT) - 'IL:REPLACE)) + (IL:* IL:|;;| "Now make a slug (block)") + + (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH) + 0 + (1- SLUGWIDTH) + (+ ASCENT DESCENT) + 'IL:REPLACE) CSINFO)))) -(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) +(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (IL:* IL:\; "Edited 30-Nov-2025 15:59 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 18:03 by mth") + (IL:* IL:\; "Edited 20-Nov-2025 12:46 by mth") (IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") + + (IL:* IL:|;;| "Check valid required arguments") + (WHEN (AND (BDF-FONT-P BDFONT) - FAMILY) (IL:* IL:\; "FAMILY Cannot be NIL") - (PROG* ((SLUG (BF-SLUG BDFONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - FONTDESC DEV GBCSL CHARSETS) - (WHEN (FONTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY) - (OR SIZE (FONTPROP FAMILY 'IL:SIZE)) - (OR FACE (FONTPROP FAMILY 'IL:FACE)) - (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) - (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE)) - MAP-UNKNOWN-TO-PRIVATE))) - (WHEN (LISTP FAMILY) - - (IL:* IL:|;;| "Assume this is a FONTSPEC") - - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC IL:FSFAMILY) - IL:|of| FAMILY) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) IL:|of| FAMILY) - SIZE) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSFACE) IL:|of| FAMILY) - FACE "MRR") - (OR (IL:|fetch| (IL:FONTSPEC IL:FSROTATION) IL:|of| FAMILY) - ROTATION 0) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) IL:|of| FAMILY) - DEVICE - 'DISPLAY) - MAP-UNKNOWN-TO-PRIVATE))) - (SETQ FAMILY (IL:\\FONTSYMBOL FAMILY)) - (UNLESS (AND (INTEGERP SIZE) - (PLUSP SIZE)) - (ERROR "Invalid SIZE: ~S~%" SIZE)) - (COND - ((NULL ROTATION) - (SETQ ROTATION 0)) - ((NOT (AND (INTEGERP ROTATION) - (>= ROTATION 0))) - (IL:\\ILLEGAL.ARG ROTATION))) - (SETQ DEV DEVICE) - (SETQ DEV (COND - ((NULL DEVICE) - 'DISPLAY) - ((AND (SYMBOLP DEVICE) - (NOT (EQ DEVICE T))) - - (IL:* IL:|;;| + FAMILY) + (WHEN (FONTP FAMILY) + (RETURN-FROM BDF-TO-FONTDESCRIPTOR (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY + 'IL:FAMILY) + (OR SIZE (FONTPROP FAMILY 'IL:SIZE)) + (OR FACE (FONTPROP FAMILY 'IL:FACE)) + (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) + (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))))) + (WHEN (LISTP FAMILY) + + (IL:* IL:|;;| "Assume this is a FONTSPEC.") + + (RETURN-FROM BDF-TO-FONTDESCRIPTOR (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC + IL:FSFAMILY) + IL:|of| FAMILY) + (OR SIZE (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) + IL:|of| FAMILY)) + (OR FACE (IL:|fetch| (IL:FONTSPEC IL:FSFACE) + IL:|of| FAMILY) + 'IL:MRR) + (OR ROTATION (IL:|fetch| (IL:FONTSPEC + IL:FSROTATION) + IL:|of| FAMILY) + 0) + (OR DEVICE (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) + IL:|of| FAMILY) + 'DISPLAY)))) + (LET ((XLFD (BF-XLFD BDFONT)) + FONTDESC GBCSL CHARSETS SLUGWIDTH) + (SETQ FAMILY (IL:\\FONTSYMBOL (OR FAMILY (XLFD-FAMILY XLFD)))) + (SETQ FACE (OR FACE (XLFD-TO-FACE XLFD))) + (SETQ SIZE (OR SIZE (AND (>= (XLFD-PIXEL¬SIZE XLFD) + 0) + (XLFD-PIXEL¬SIZE XLFD)) + (AND (>= (XLFD-POINT¬SIZE XLFD) + 0) + (CEILING (XLFD-POINT¬SIZE XLFD) + 10)) + (FIRST (BF-SIZE BDFONT)))) + (COND + ((NULL ROTATION) + (SETQ ROTATION 0)) + ((NOT (AND (IL:SMALLP ROTATION) + (>= ROTATION 0))) + (IL:\\ILLEGAL.ARG ROTATION))) + (SETQ DEVICE (COND + ((OR (NULL DEVICE) + (EQ DEVICE T)) + 'DISPLAY) + ((SYMBOLP DEVICE) + + (IL:* IL:|;;| + "This PROBABLY isn't a good assumption... BUT it's a very unlikely case.") + + (IL:* IL:|;;|  "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.") - DEVICE) - ((STRINGP DEVICE) - (INTERN (STRING-UPCASE DEVICE) - "IL")) - (T (IL:\\ILLEGAL.ARG DEVICE)))) - (SETQ FACE (IL:\\FONTFACE FACE NIL DEV)) - (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) - (UNLESS SLUGWIDTH - - (IL:* IL:|;;| - "If GLYPHS-BY-CHARSET didn't determine the SLUG width, use 60% of the SIZE, at least 1") - - (SETQ SLUGWIDTH (OR (THIRD GBCSL) - (MAX 1 (ROUND (* 0.6 SIZE)))))) - (FLET ((GBCS-TO-FONTDESC - (GBCS FAMILY) - (LET (FONTDESC CHARSETS) - (WHEN GBCS - (SETQ FONTDESC - (IL:|create| FONTDESCRIPTOR - IL:FONTDEVICE IL:_ DEV - IL:FONTFAMILY IL:_ FAMILY - IL:FONTSIZE IL:_ SIZE - IL:FONTFACE IL:_ FACE - IL:|\\SFAscent| IL:_ 0 - IL:|\\SFDescent| IL:_ 0 - IL:|\\SFHeight| IL:_ 0 - IL:ROTATION IL:_ ROTATION - IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION - DEV))) - (SETQ CHARSETS (LOOP :FOR CS :IN GBCS :WITH CSET :WITH CSINFO :NCONC - (WHEN (<= 0 (SETQ CSET (FIRST CS)) - MAXCHARSET) - (SETQ CSINFO (BDF-TO-CHARSETINFO - GBCS CSET (OR SLUG (1+ - SLUGWIDTH - )))) - (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET - ) - (LIST CSET))))) - (LIST FONTDESC CHARSETS)))) - (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) - FAMILY) - (GBCS-TO-FONTDESC (SECOND GBCSL) - (IL:\\FONTSYMBOL (CONCATENATE 'STRING - (SYMBOL-NAME FAMILY) - "-UNMAPPED"))) - (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) - :TEST - #'EQL))))))))) - -(DEFUN BUILD-COMPOSITE (BASE-FONT &REST FILL-FROM) (IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth") + DEVICE) + ((STRINGP DEVICE) + (INTERN (STRING-UPCASE DEVICE) + "IL")) + (T (IL:\\ILLEGAL.ARG DEVICE)))) + (SETQ FACE (IL:\\FONTFACE (OR FACE (XLFD-TO-FACE XLFD) + 'IL:MRR) + NIL DEVICE)) + (DESTRUCTURING-SETQ (GBCSL SLUGWIDTH) + (GLYPHS-BY-CHARSET BDFONT)) + (UNLESS SLUGWIDTH + + (IL:* IL:|;;| + "If GLYPHS-BY-CHARSET didn't determine the SLUGWIDTH, use 60% of the SIZE, at least 1") + + (SETQ SLUGWIDTH (MAX 1 (ROUND (* 0.6 SIZE))))) + (WHEN GBCSL + (SETQ FONTDESC + (IL:|create| FONTDESCRIPTOR + IL:FONTDEVICE IL:_ DEVICE + IL:FONTFAMILY IL:_ FAMILY + IL:FONTSIZE IL:_ SIZE + IL:FONTFACE IL:_ FACE + IL:|\\SFAscent| IL:_ 0 + IL:|\\SFDescent| IL:_ 0 + IL:|\\SFHeight| IL:_ 0 + IL:ROTATION IL:_ ROTATION + IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION DEVICE) + IL:FONTSLUGWIDTH IL:_ SLUGWIDTH)) + (SETQ CHARSETS (LOOP :FOR CS :IN GBCSL :WITH CSET :WITH CSINFO :NCONC + (WHEN (<= 0 (SETQ CSET (FIRST CS)) + MAXCHARSET) + (SETQ CSINFO (BDF-TO-CHARSETINFO GBCSL CSET (1+ SLUGWIDTH))) + (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) + (LIST CSET))))) + (LIST FONTDESC CHARSETS)))) + +(DEFUN BUILD-COMPOSITE (BASE-FONT &REST FILL-FROM) (IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 21:23 by mth") + (IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth") (IL:* IL:\; "Edited 16-Nov-2025 18:25 by mth") (IL:* IL:\; "Edited 14-Nov-2025 17:04 by mth") - (LET (UCHAR-PRESENT FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) + (LET (MCHAR-PRESENT FONT) (UNLESS (AND FILL-FROM (LISTP FILL-FROM)) (ERROR "FILL-FROM is not a list.")) + (WHEN (LISTP BASE-FONT) + + (IL:* IL:|;;| "Allow specifying both BASE-FONT and FILL-FROM in a single LIST.") + + (SETQ FONT (FIRST BASE-FONT)) + (SETQ FILL-FROM (APPEND (REST BASE-FONT) + FILL-FROM)) + (SETQ BASE-FONT FONT)) (COND ((OR (STRINGP BASE-FONT) (PATHNAMEP BASE-FONT)) (UNLESS (IL:INFILEP BASE-FONT) (ERROR "BASE-FONT ~S doesn't exist or is unreadable." BASE-FONT)) - (MULTIPLE-VALUE-SETQ (FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) - (READ-BDF BASE-FONT :MCCS-ONLY T)) - (SETQ BASE-FONT FONT) - (SETQ UCHAR-PRESENT UC-PRESENT)) - ((TYPEP BASE-FONT 'BDF-FONT) - (SETQ UCHAR-PRESENT (GET-CHARS-PRESENT BASE-FONT))) - (T (ERROR "BASE-FONT is not a BDF-FONT, nor string, nor pathname."))) - (UNLESS UCHAR-PRESENT) - (LOOP :FOR FILL-FONT :IN FILL-FROM :WHEN FILL-FONT :DO - (COND - ((OR (STRINGP FILL-FONT) - (PATHNAMEP FILL-FONT)) - (UNLESS (IL:INFILEP FILL-FONT) - (ERROR "Element of FILL-FROM (~S) doesn't exist or is unreadable." FILL-FONT - )) - (MULTIPLE-VALUE-SETQ (FONT FAMILY WEIGHT SLANT EXPANSION SIZE UC-PRESENT) - (READ-BDF FILL-FONT :MCCS-ONLY T)) - (SETQ FILL-FONT FONT)) - ((NOT (TYPEP FILL-FONT 'BDF-FONT)) - (ERROR "Element of FILL-FROM (~S) is not a BDF-FONT, nor string, nor pathname." - FILL-FONT))) + (SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T))) + ((NOT (TYPEP BASE-FONT 'BDF-FONT)) + (ERROR "BASE-FONT is not a BDF-FONT, nor string, nor pathname."))) + (SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT)) + (LOOP :FOR FILL-FONT :IN FILL-FROM :WHEN FILL-FONT :DO (COND + ((OR (STRINGP FILL-FONT) + (PATHNAMEP FILL-FONT)) + (UNLESS (IL:INFILEP FILL-FONT) + (ERROR + "Element of FILL-FROM (~S) doesn't exist or is unreadable." + FILL-FONT)) + (SETQ FILL-FONT + (READ-BDF FILL-FONT + :MCCS-ONLY T))) + ((NOT (BDF-FONT-P FILL-FONT)) + (ERROR + "Element of FILL-FROM (~S) is not a BDF-FONT, nor string, nor pathname." + FILL-FONT))) (LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT) :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) (WHEN (AND (LISTP V) @@ -363,11 +356,8 @@  "Need to change this use of UTOMCODE? based on the CHARSET¬REGISTRY of the XLFD of FILL-FONT") (WHEN (AND (UTOMCODE? V) - (ZEROP (BIT (AREF UCHAR-PRESENT (LRSH V 8)) - (LOGAND V 255)))) - (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) - (LOGAND V 255)) - 1) + (ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V))) + (CHAR-PRESENT-BIT MCHAR-PRESENT V 1) (IL:* IL:|;;|  "What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?") @@ -375,226 +365,80 @@ (PUSH GL (BF-GLYPHS BASE-FONT))))) BASE-FONT)) -(DEFUN GET-CHARS-PRESENT (BFONT) (IL:* IL:\; "Edited 16-Nov-2025 17:52 by mth") - (IL:* IL:\; "Edited 14-Nov-2025 16:40 by mth") - (UNLESS (TYPEP BFONT 'BDF-FONT) - (ERROR "BFONT is not a BDF-FONT.")) - (LET ((UCHAR-PRESENT (MAKE-ARRAY 256 :INITIAL-CONTENTS (LOOP :FOR I :FROM 0 :TO 255 :COLLECT - (MAKE-ARRAY 256 :ELEMENT-TYPE - 'BIT :INITIAL-ELEMENT 0))))) - (LOOP :FOR GL :IN (BF-GLYPHS BFONT) - :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - (WHEN (UTOMCODE? V) - (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) - (LOGAND V 255)) - 1))) - UCHAR-PRESENT)) - -(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (FONTNAME) (IL:* IL:\; "Edited 18-Nov-2025 15:15 by mth") - (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") - (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth") - (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") - (UNLESS (STRINGP FONTNAME) - (IL:\\ILLEGAL.ARG FONTNAME)) - (FLET ((PARSE-P-SIZE (SZSTR) - (COND - ((ZEROP (LENGTH SZSTR)) - -1) - ((PARSE-INTEGER SZSTR :JUNK-ALLOWED T)) - (T -1)))) - (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD¬STYLE¬NAME PIXEL¬SIZE - POINT¬SIZE RESOLUTION¬X RESOLUTION¬Y SPACING AVERAGE¬WIDTH - CHARSET¬REGISTRY CHARSET¬ENCODING) - (SPLIT-FONT-NAME FONTNAME) - - (IL:* IL:|;;| "Now, parse pieces as XLFD format") - - (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) - (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) - '((#\R . MEDIUM) - (#\M . MEDIUM) - (#\N . MEDIUM) - (#\B . BOLD) - (#\D . BOLD) - (#\L . LIGHT))))) - 'MEDIUM)) (IL:* IL:\; "DemiBold => BOLD") - (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) - '((REGULAR) - (#\R . REGULAR) - (#\I . ITALIC) - (#\O . ITALIC))))) - 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") - (IL:* IL:\; "Ignore others") - (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) - '((#\R . REGULAR) - (#\N . REGULAR) - (#\B . BOLD) - (#\S . COMPRESSED) - (#\C . COMPRESSED))))) - 'REGULAR)) (IL:* IL:\; - "S is for \"SemiCondensed\", Assuming \"Condensed\"") - - (IL:* IL:|;;| - "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") - - (WHEN (AND (EQ WEIGHT EXPANSION) - (EQ EXPANSION 'BOLD)) - (SETQ EXPANSION 'REGULAR)) - (SETQ PIXEL¬SIZE (PARSE-P-SIZE PIXEL¬SIZE)) - (SETQ POINT¬SIZE (PARSE-P-SIZE POINT¬SIZE)) - (MAKE-XLFD :FOUNDRY FOUNDRY :FAMILY FAMILY :WEIGHT WEIGHT :SLANT SLANT :EXPANSION - EXPANSION :ADD¬STYLE¬NAME ADD¬STYLE¬NAME :PIXEL¬SIZE :POINT¬SIZE :RESOLUTION¬X - RESOLUTION¬X :RESOLUTION¬Y RESOLUTION¬Y :SPACING SPACING :AVERAGE¬WIDTH - AVERAGE¬WIDTH :CHARSET¬REGISTRY CHARSET¬REGISTRY :CHARSET¬ENCODING - CHARSET¬ENCODING)))) - -(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) +(DEFUN CHAR-PRESENT-BIT (BM MCODE &OPTIONAL (NEWBIT -1 SBIT) + &AUX CS CC) (IL:* IL:\; "Edited 26-Nov-2025 09:29 by mth") + (COND + ((NOT (TYPEP BM 'IL:BITMAP)) + (ERROR "BM is not a BITMAP")) + ((NOT (AND (INTEGERP MCODE) + (<= 0 MCODE 65535))) + (ERROR "Invalid MCODE")) + (SBIT (COND + ((OR (EQL NEWBIT 1) + (EQ NEWBIT T)) + (SETQ NEWBIT 1)) + ((OR (EQL NEWBIT 0) + (NULL NEWBIT)) + (SETQ NEWBIT 0)) + (T (ERROR "Invalid NEWBIT"))))) + (LET ((CS (- 255 (LRSH MCODE 8))) + (CC (LOGAND MCODE 255))) + (BITMAPBIT BM CC CS (AND SBIT NEWBIT)))) + +(DEFUN COUNT-MCHARS (BDFONT) (IL:* IL:\; "Edited 29-Nov-2025 23:52 by mth") + (WHEN (BDF-FONT-P BDFONT) + (LET ((MCPBM (BF-MCHAR-PRESENT BDFONT))) + (LOOP :FOR MC :FROM 0 :TO 65535 :COUNT (PLUSP (CHAR-PRESENT-BIT MCPBM MC)))))) + +(DEFUN GLYPHS-BY-CHARSET (FONT) (IL:* IL:\; "Edited 30-Nov-2025 17:36 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 17:24 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 20:50 by mth") + (IL:* IL:\; "Edited 20-Nov-2025 12:01 by mth") (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") (IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth") (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") (LET* ((NCSETS (+ MAXCHARSET 2)) (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) - (UTOMFN (COND - (RAW-UNICODE-MAPPING #'IDENTITY) - (MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE) - (T #'UTOMCODE?))) - (SLUG (BF-SLUG FONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - NOMAPPINGCSETS ENC MCODE MCS) - (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT - (CONS NIL))))) - (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY) - (TCONC (AREF CSARRAY (LRSH CODE 8)) + SLUGWIDTH ENC MCODE CS-USED) + (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY &AUX CS) + (TCONC (AREF CSARRAY (SETQ CS (LRSH CODE 8))) (CONS (LOGAND CODE 255) - GLYPH)))) + GLYPH)) + (PUSHNEW CS CS-USED :TEST #'EQL))) (LOOP :FOR GL :IN (BF-GLYPHS FONT) - :UNLESS - (EQ GL SLUG) :DO - (SETQ MCS NIL) - (SETQ ENC (GLYPH-ENCODING GL)) - (WHEN (LISTP ENC) - - (IL:* IL:|;;| - "Should happen only if -1 is first on ENCODING line in BDF file") - - (SETQ ENC (OR (SECOND ENC) - -1)) - - (IL:* IL:|;;| - "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it") - - ) - (SETQ MCODE (AND (INTEGERP ENC) - (PLUSP ENC) - (FUNCALL UTOMFN ENC))) - (IF RAW-UNICODE-MAPPING - (COND - ((> ENC 65535) - (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((AND NIL (= 255 (LOGAND ENC 255))) + (SETQ MCODE (GLYPH-MCODE GL)) + (COND + ((AND (INTEGERP MCODE) + (<= 0 MCODE 65535)) - (IL:* IL:|;;| - "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode") - - (WARN - "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR" - (LRSH ENC 8) - (LRSH ENC 8)) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) - (COND - ((AND (ZEROP (GLYPH-BBW GL)) - (ZEROP (FIRST (GLYPH-DWIDTH GL)))) - - (IL:* IL:|;;| - "This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((NULL MCODE) + (IL:* IL:|;;| "These assoc with the 8 bit character code within the charset") - (IL:* IL:|;;| "These assoc with the Unicode encoding") + (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) - (COND - ((OR (> ENC 65535) - (= 255 (LOGAND ENC 255))) + (IL:* IL:|;;| "Default SLUG width is width of A, in charset 0") - (IL:* IL:|;;| - "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) - ((AND (INTEGERP MCODE) - (<= 0 MCODE 65535)) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset") + (WHEN (AND (NOT SLUGWIDTH) + (ZEROP (LRSH MCODE 8)) + (EQL MCODE (CHAR-CODE #\A))) + (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) + (T + (IL:* IL:|;;| "Shouldn't happen!") - (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) + (ERROR "Invalid MCODE: ~A~%"))))) + (SETQ CSETS (LOOP :FOR I :IN CS-USED :NCONC (LET ((CS (CAR (AREF CSETS I)))) - (IL:* IL:|;;| "Default SLUG width is width of A.") + (IL:* IL:|;;| + "Extract the lists from the TCONC pointers") - (WHEN (AND (NOT SLUGWIDTH) - (= ENC (CHAR-CODE #\A))) - - (IL:* IL:|;;| "A is the same code in MCCS and UNICODE ") - - (IL:* IL:|;;| - "Comparing with ENC, not MCODE, to look only in charset 0") - - (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) - ((LISTP MCODE) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset (like above)") - - (LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS - (LRSH MC 8)) - MCS) - :DO - (PUSH CS MCS) - (PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS))) - (T (ERROR "Invalid MCODE: ~A~%")))))) - - (IL:* IL:|;;| "Extract the lists from the TCONC pointers") - - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I) - (SORT (REMOVE-DUPLICATES - (CAR (AREF CSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF CSETS I))) - (WHEN CS - (LIST (LIST I CS)))))) - - (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.") - - (WHEN NOMAPPINGCSETS - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO - (SETF (AREF NOMAPPINGCSETS I) - (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF NOMAPPINGCSETS I))) - (WHEN CS - (LIST (LIST I CS))))))) - (LIST CSETS NOMAPPINGCSETS SLUGWIDTH))) + (SETQ CS (SORT (REMOVE-DUPLICATES + CS :TEST #'EQUAL) + #'< :KEY #'CAR)) + (WHEN CS + (LIST (LIST I CS)))))) + (LIST (SORT CSETS #'< :KEY #'CAR) + SLUGWIDTH))) (DEFMACRO PACKFILENAME.STRING (&WHOLE WHOLE) (IL:* IL:\; "Edited 1-Feb-2025 23:17 by mth") `(IL:PACKFILENAME.STRING ,@(LOOP :FOR X :IN (CDR WHOLE) @@ -617,19 +461,22 @@ Y)))) (DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1)) - (IL:* IL:\; "Edited 18-Nov-2025 19:39 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 11:59 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 17:39 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 22:47 by mth") + (IL:* IL:\; "Edited 19-Nov-2025 23:15 by mth") (IL:* IL:\; "Edited 14-Nov-2025 16:35 by mth") (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") (LET - (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL XLFD (NGLYPHS - 0) - (UCHAR-PRESENT (MAKE-ARRAY 256 :INITIAL-CONTENTS (LOOP :FOR I :FROM 0 :TO 255 :COLLECT - (MAKE-ARRAY 256 :ELEMENT-TYPE - 'BIT :INITIAL-ELEMENT 0)))) - (*PACKAGE* (FIND-PACKAGE "BDF"))) + ((NGLYPHS 0) + (MCHAR-PRESENT (BITMAPCREATE 256 256 1)) + (*PACKAGE* (FIND-PACKAGE "BDF")) + (MAPPED-GLYPHS (LIST NIL)) + (UNMAPPED-GLYPHS (LIST NIL)) + PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL XLFD) (IL:* IL:|;;| "Note: The EXTERNAL-FORMAT *ought* to be :UTF-8 for the BDF files from otf2bdf, but I'm seeing :ISO8859/1. I don't know why! But I'm setting the default :EXTERNAL-FORMAT appropriately for this.") @@ -647,7 +494,7 @@ (IL:* IL:|;;| "ignore the file format version number") (READ-LINE FILE-STREAM) - (SETQ FONT (MAKE-BDF-FONT)) + (SETQ FONT (MAKE-BDF-FONT :MCHAR-PRESENT MCHAR-PRESENT)) (LOOP :UNTIL FONT-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) (WHEN LINE (IL:* IL:\; "Ignore blank lines") @@ -661,7 +508,7 @@ (SETF (BF-NAME FONT) LINE) (SETF (BF-XLFD FONT) - (GET-FAMILY-FACE-SIZE-FROM-NAME LINE))) + (SETQ XLFD (XLFD-SPLIT-FONT-NAME LINE)))) (T (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) (CASE KEY @@ -727,32 +574,42 @@ (PLUSP NGLYPHS)) (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." NGLYPHS)) + (LOOP :REPEAT NGLYPHS :WITH ENC :WITH MC :DO (SETQ GL (READ-GLYPH + FILE-STREAM + FONT)) + (SETQ ENC (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP ENC) + (EQ (FIRST ENC) + -1)) + (SETQ ENC (OR (SECOND ENC) + -1))) + (COND + ((AND (OR (PLUSP (GLYPH-BBW GL)) + (PLUSP (FIRST (GLYPH-DWIDTH GL)))) + (SETQ MC (UTOMCODE? ENC))) + + (IL:* IL:|;;| "This glyph must have either a non-zero-width \"image\" or a non-zero-width \"escapement\", otherwise it cannot be mapped, no matter the UTOMCODE? value.") + + (LOOP :FOR CC :IN (IL:MKLIST MC) + :WITH CGL :DO + + (IL:* IL:|;;| "Copy GL if multiple MCODEs") + + (SETQ CGL (IF (LISTP MC) + (COPY-GLYPH GL) + GL)) + (SETF (GLYPH-MCODE CGL) + CC) + + (IL:* IL:|;;| "It ought to be safe to share the bitmap") + + (TCONC MAPPED-GLYPHS CGL) + (CHAR-PRESENT-BIT MCHAR-PRESENT CC 1))) + (T (TCONC UNMAPPED-GLYPHS GL)))) (SETF (BF-GLYPHS FONT) - (LOOP :REPEAT NGLYPHS :NCONC - (PROGN (SETQ GL (READ-GLYPH FILE-STREAM FONT)) - (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - (COND - ((EQ V -1) - - (IL:* IL:|;;| - "Any GLYPH with ENCODING of -1 will be ignored.") - - NIL) - ((UTOMCODE? V) - - (IL:* IL:|;;| - "Need to change this based on the CHARSET¬REGISTRY of the XLFD") - - (SETF (BIT (AREF UCHAR-PRESENT (LRSH V 8)) - (LOGAND V 255)) - 1) - (LIST GL)) - (T NIL)))))) + (CAR MAPPED-GLYPHS)) + (SETF (BF-UNMAPPED¬GLYPHS FONT) + (CAR UNMAPPED-GLYPHS))) (ENDFONT (SETQ FONT-COMPLETE T)))))))) (WHEN VERBOSE @@ -766,22 +623,16 @@ (XLFD-POINT¬SIZE XLFD) (XLFD-WEIGHT XLFD) (XLFD-SLANT XLFD) - (XLFD-EXPANSION XLFD))) - (VALUES FONT (XLFD-FAMILY XLFD) - (XLFD-WEIGHT XLFD) - (XLFD-SLANT XLFD) - (XLFD-EXPANSION XLFD) - (LIST (FIRST (BF-SIZE FONT)) - (XLFD-PIXEL¬SIZE XLFD) - (XLFD-POINT¬SIZE XLFD)) - UCHAR-PRESENT)))) + (XLFD-SETWIDTH¬NAME XLFD))) + FONT))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT))) (READ-DELIMITED-LIST DELIMIT SI))) -(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 17-Nov-2025 20:03 by mth") +(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 26-Nov-2025 23:32 by mth") + (IL:* IL:\; "Edited 17-Nov-2025 20:03 by mth") (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth") (IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth") @@ -840,37 +691,41 @@ (THIRD ITEMS) (GLYPH-BBYOFF0 GLYPH) (FOURTH ITEMS))) - (BITMAP (LET* ((BM (BITMAPCREATE BBW BBH 1)) - (BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM)) - (BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH - IL:|of| BM)) - (NBYTES (CEILING BBW 8)) - (NCHARS (* 2 NBYTES)) - (NWORDS (CEILING BBW 16)) - BITS BYTEPOS WORDINDEX) - (LOOP :WITH BITROW = 0 :REPEAT BBH :DO - (SETQ LINE (STRING-TRIM '(#\Space #\Tab) - (READ-LINE FILE-STREAM))) - (UNLESS (AND (EQUAL NCHARS (LENGTH LINE)) - (SETQ BITS - (PARSE-INTEGER LINE :RADIX 16 - :JUNK-ALLOWED T))) - (ERROR + (BITMAP (UNLESS (ZEROP (* BBW BBH)) + + (IL:* IL:|;;| "Don't bother creating a BITMAP with no area") + + (LET* ((BM (BITMAPCREATE BBW BBH 1)) + (BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM)) + (BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH + IL:|of| BM)) + (NBYTES (CEILING BBW 8)) + (NCHARS (* 2 NBYTES)) + (NWORDS (CEILING BBW 16)) + BITS BYTEPOS WORDINDEX) + (LOOP :WITH BITROW = 0 :REPEAT BBH :DO + (SETQ LINE (STRING-TRIM '(#\Space #\Tab) + (READ-LINE FILE-STREAM))) + (UNLESS (AND (EQUAL NCHARS (LENGTH LINE)) + (SETQ BITS + (PARSE-INTEGER LINE :RADIX 16 + :JUNK-ALLOWED T))) + (ERROR "Invalid BDF file - bad line in BITMAP: ~A" - LINE)) - (WHEN (ODDP NBYTES) - (SETQ BITS (ASH BITS 8))) - (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) - (SETQ BYTEPOS (* 16 (1- NWORDS))) - (LOOP :REPEAT NWORDS :DO - (IL:\\PUTBASE BM.BASE WORDINDEX - (LDB (BYTE 16 BYTEPOS) - BITS)) - (INCF WORDINDEX) - (DECF BYTEPOS 16)) - (INCF BITROW)) - (SETF (GLYPH-BITMAP GLYPH) - BM))) + LINE)) + (WHEN (ODDP NBYTES) + (SETQ BITS (ASH BITS 8))) + (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) + (SETQ BYTEPOS (* 16 (1- NWORDS))) + (LOOP :REPEAT NWORDS :DO + (IL:\\PUTBASE BM.BASE WORDINDEX + (LDB (BYTE 16 BYTEPOS) + BITS)) + (INCF WORDINDEX) + (DECF BYTEPOS 16)) + (INCF BITROW)) + (SETF (GLYPH-BITMAP GLYPH) + BM)))) (ENDCHAR (SETQ CHAR-COMPLETE T))))))) (SETF (GLYPH-ASCENT GLYPH) (+ (GLYPH-BBH GLYPH) @@ -883,123 +738,118 @@ (FIRST (GLYPH-DWIDTH GLYPH)))) GLYPH)) -(DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth") - (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") - - (IL:* IL:|;;| "First, check if it COULD be in XLFD format") - - (COND - ((POSITION #\- NAME :TEST #'CHAR=) - (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) - 1 - 0) - THEN - (1+ J) - :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=) - :COLLECT - (SUBSEQ NAME I J) - :WHILE J)) - (T - (IL:* IL:|;;| "Return the NAME as FAMILY with a NIL FOUNDRY") - - (LIST NIL NAME)))) - -(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE - MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED - RAW-UNICODE-MAPPING (CHAR-SETS T)) - (IL:* IL:\; "Edited 18-Nov-2025 15:37 by mth") - (IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth") - (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") - (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") - (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") +(DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE + &AUX FULLFILENAME) + (IL:* IL:\; "Edited 30-Nov-2025 16:03 by mth") + (IL:* IL:\; "Edited 28-Nov-2025 17:56 by mth") + (IL:* IL:\; "Edited 26-Nov-2025 21:07 by mth") + (IL:* IL:\; "Edited 16-Nov-2025 17:32 by mth") (UNLESS (TYPEP BDFONT 'BDF-FONT) (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) - (COND - ((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets") - ) - ((NULL CHAR-SETS) - (SETQ CHAR-SETS '(0)) (IL:* IL:\; "Only charset 0") - ) - ((AND (INTEGERP CHAR-SETS) - (<= 0 CHAR-SETS MAXCHARSET)) (IL:* IL:\; "A single integer charset") - (SETQ CHAR-SETS (LIST CHAR-SETS))) - ((AND (LISTP CHAR-SETS) - (EVERY #'(LAMBDA (CS) - (AND (INTEGERP CS) - (<= 0 CS MAXCHARSET))) - CHAR-SETS))) - (T (ERROR "Invalid specification of :CHAR-SETS ~S~%" CHAR-SETS))) - (LET ((XLFD (BF-XLFD BDFONT))) - (SETQ FAMILY (OR FAMILY (XLFD-FAMILY XLFD))) - (WHEN RAW-UNICODE-MAPPING - (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) - (SETQ FACE (OR FACE (LIST (XLFD-WEIGHT XLFD) - (XLFD-SLANT XLFD) - (XLFD-EXPANSION XLFD)))) - (SETQ SIZE (OR SIZE (AND (>= (XLFD-PIXEL¬SIZE XLFD) - 0) - (XLFD-PIXEL¬SIZE XLFD)) - (AND (>= (XLFD-POINT¬SIZE XLFD) - 0) - (CEILING (XLFD-POINT¬SIZE XLFD) - 10)) - (FIRST (BF-SIZE BDFONT)))) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) - (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE MAP-UNKNOWN-TO-PRIVATE - RAW-UNICODE-MAPPING) - (UNLESS (EQ CHAR-SETS T) - (SETQ CSETS (INTERSECTION CHAR-SETS CSETS)) - (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) - (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS - (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME FAMILY SIZE FACE - "DISPLAYFONT" CS)))) - (IF WRITE-UNMAPPED - (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE - UNMAPPED-FONTDESC CS - (PACKFILENAME.STRING - :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME (FONTPROP - UNMAPPED-FONTDESC - 'IL:FAMILY) - SIZE FACE "DISPLAYFONT" CS)))) - (SETQ UNICODE-CSETS NIL)) + (DESTRUCTURING-BIND (FONTDESC CSETS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (UNLESS FONTDESC - (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") + (IL:* IL:|;;| "Creation of the FONTDESCRIPTOR failed!") - (IL:* IL:|;;| - "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)") + (HELP "FONTDESC IS NIL")) - (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) + (IL:* IL:|;;| "CSETS correspond to the charsets actually present in the FONTDESC.") -(DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE - &AUX FULLFILENAME) - (IL:* IL:\; "Edited 18-Nov-2025 15:37 by mth") - (IL:* IL:\; "Edited 16-Nov-2025 17:32 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) - (LET ((XLFD (BF-XLFD BDFONT))) - (SETQ FAMILY (OR FAMILY (XLFD-FAMILY XLFD))) - (SETQ FACE (OR FACE (LIST (XLFD-WEIGHT XLFD) - (XLFD-SLANT XLFD) - (XLFD-EXPANSION XLFD)))) - (SETQ SIZE (OR SIZE (AND (>= (XLFD-PIXEL¬SIZE XLFD) - 0) - (XLFD-PIXEL¬SIZE XLFD)) - (AND (>= (XLFD-POINT¬SIZE XLFD) - 0) - (CEILING (XLFD-POINT¬SIZE XLFD) - 10)) - (FIRST (BF-SIZE BDFONT)))) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS) - (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE) - (SETQ FULLFILENAME (MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME FONTDESC NIL - NIL DEST-DIR))) - - (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") - - (VALUES FULLFILENAME FONTDESC CSETS)))) + (SETQ FULLFILENAME (MEDLEYFONT.WRITE.FONT FONTDESC (MEDLEYFONT.FILENAME FONTDESC NIL NIL + DEST-DIR))) + (LIST FULLFILENAME FONTDESC CSETS))) + +(DEFUN XLFD-SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 26-Nov-2025 09:43 by mth") + (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth") + (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") + (LET (PARTS (XLFD (MAKE-XLFD))) + + (IL:* IL:|;;| "First, check if it COULD be in XLFD format") + + (SETQ PARTS (IF (POSITION #\- NAME :TEST #'CHAR=) + (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) + 1 + 0) + THEN + (1+ J) + :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=) + :COLLECT + (SUBSEQ NAME I J) + :WHILE J) + (PROGN + (IL:* IL:|;;| + "There are no -'s, so use the NAME as the FAMILY with a NIL FOUNDRY") + + (LIST NIL NAME)))) + (FLET ((PARSE-P-SIZE (SZSTR) + (COND + ((ZEROP (LENGTH SZSTR)) + -1) + ((PARSE-INTEGER SZSTR :JUNK-ALLOWED T)) + (T -1)))) + (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT SETWIDTH¬NAME ADD¬STYLE¬NAME + PIXEL¬SIZE POINT¬SIZE RESOLUTION¬X RESOLUTION¬Y SPACING + AVERAGE¬WIDTH CHARSET¬REGISTRY CHARSET¬ENCODING) + PARTS + (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) + (SETQ PIXEL¬SIZE (PARSE-P-SIZE PIXEL¬SIZE)) + (SETQ POINT¬SIZE (PARSE-P-SIZE POINT¬SIZE)) + (MAKE-XLFD :FOUNDRY FOUNDRY :FAMILY FAMILY :WEIGHT WEIGHT :SLANT SLANT + :SETWIDTH¬NAME SETWIDTH¬NAME :ADD¬STYLE¬NAME ADD¬STYLE¬NAME :PIXEL¬SIZE + PIXEL¬SIZE :POINT¬SIZE POINT¬SIZE :RESOLUTION¬X RESOLUTION¬X + :RESOLUTION¬Y RESOLUTION¬Y :SPACING SPACING :AVERAGE¬WIDTH AVERAGE¬WIDTH + :CHARSET¬REGISTRY CHARSET¬REGISTRY :CHARSET¬ENCODING CHARSET¬ENCODING))))) + +(DEFUN XLFD-TO-FACE (XLFD) (IL:* IL:\; "Edited 25-Nov-2025 17:50 by mth") + (UNLESS (TYPEP XLFD 'XLFD) + (ERROR "Not an XLFD object: ~S ~%" XLFD)) + (LET ((WEIGHT (XLFD-WEIGHT XLFD)) + (SLANT (XLFD-SLANT XLFD)) + (EXPANSION (XLFD-SETWIDTH¬NAME XLFD))) + + (IL:* IL:|;;| "mth 11-25-2025 Brute force hackery now. This needs to be made smarter.") + + (SETQ WEIGHT (OR (AND WEIGHT (CADR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) + '((#\R MEDIUM) + (#\M MEDIUM) + (#\N MEDIUM) + (#\B BOLD) + (#\D BOLD + (IL:* IL:\; "DemiBold => BOLD")) + (#\L LIGHT))))) + 'MEDIUM)) + (SETQ SLANT (OR (AND SLANT (CADR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) + '((REGULAR) + (#\R REGULAR) + (#\I ITALIC) + (#\O ITALIC + (IL:* IL:\; "Oblique => ITALIC")))))) + 'REGULAR)) (IL:* IL:\; "Ignore other SLANTs") + + (IL:* IL:|;;| "Expansion (SETWIDTH¬NAME) has many more options than these, and they aren't 1st character unique! Apparently, there's no set of (semi-)standard names.") + + (SETQ EXPANSION (OR (AND EXPANSION (CADR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) + '((#\R REGULAR) + (#\N REGULAR) + (#\E EXPANDED + (IL:* IL:\; + "E could be ExtraCondensed, Expanded, ExtraExpanded!!!") + ) + (#\S COMPRESSED + (IL:* IL:\; + "S is for \"SemiCompressed\", Using \"Condensed\"") + ) + (#\C COMPRESSED))))) + 'REGULAR)) + + (IL:* IL:|;;| + "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") + + (WHEN (AND (EQ WEIGHT EXPANSION) + (EQ EXPANSION 'BOLD)) + (SETQ EXPANSION 'REGULAR)) + (LIST WEIGHT SLANT EXPANSION))) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILESLOAD (IL:SYSLOAD) @@ -1013,27 +863,25 @@ (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") (:EXPORT "READ-BDF" "BUILD-COMPOSITE" "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") - (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" - "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" - "BLTSHADE" "BOLD" "COMPRESSED" - "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" - "FONTP" "FONTPROP" "INPUT" "ITALIC" - "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" - "UTOMCODE" "UTOMCODE?" - "WRITESTRIKEFONTFILE" + (:IMPORT-FROM "IL" "BITBLT" "BITMAPBIT" + "BITMAPCREATE" "BITMAPHEIGHT" + "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" + "BOLD" "COMPRESSED" "CHARSETINFO" + "DISPLAY" "FONTDESCRIPTOR" "FONTP" + "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" + "MEDIUM" "REGULAR" "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) :READTABLE "XCL" :COMPILER :COMPILE-FILE) (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) -(IL:PUTPROPS IL:READ-BDF IL:COPYRIGHT (IL:NONE)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (3325 11890 (BDF-TO-CHARSETINFO 3325 . 11890)) (11892 18310 (BDF-TO-FONTDESCRIPTOR -11892 . 18310)) (18312 21261 (BUILD-COMPOSITE 18312 . 21261)) (21263 22332 (GET-CHARS-PRESENT 21263 . -22332)) (22334 26224 (GET-FAMILY-FACE-SIZE-FROM-NAME 22334 . 26224)) (26226 33656 (GLYPHS-BY-CHARSET -26226 . 33656)) (33658 35083 (PACKFILENAME.STRING 33658 . 35083)) (35085 44000 (READ-BDF 35085 . 44000 -)) (44002 44325 (READ-DELIMITED-LIST-FROM-STRING 44002 . 44325)) (44327 50925 (READ-GLYPH 44327 . -50925)) (50927 51668 (SPLIT-FONT-NAME 50927 . 51668)) (51670 56008 (WRITE-BDF-TO-DISPLAYFONT-FILES -51670 . 56008)) (56010 57596 (WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 56010 . 57596))))) + (IL:FILEMAP (NIL (3235 10173 (BDF-TO-CHARSETINFO 3235 . 10173)) (10175 16397 (BDF-TO-FONTDESCRIPTOR +10175 . 16397)) (16399 20017 (BUILD-COMPOSITE 16399 . 20017)) (20019 20768 (CHAR-PRESENT-BIT 20019 . +20768)) (20770 21054 (COUNT-MCHARS 20770 . 21054)) (21056 24091 (GLYPHS-BY-CHARSET 21056 . 24091)) ( +24093 25518 (PACKFILENAME.STRING 24093 . 25518)) (25520 34886 (READ-BDF 25520 . 34886)) (34888 35211 ( +READ-DELIMITED-LIST-FROM-STRING 34888 . 35211)) (35213 42211 (READ-GLYPH 35213 . 42211)) (42213 43494 +(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42213 . 43494)) (43496 45913 (XLFD-SPLIT-FONT-NAME 43496 . 45913) +) (45915 48927 (XLFD-TO-FACE 45915 . 48927))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 9fd699bcf7f9f5751c2edbca2774d4593cd6ef00..faa31f3d52c8e8996ca08918d24cf61612c2c854 100644 GIT binary patch literal 24256 zcmeHvdwd+lm2P*>SZ~X+JQlJLVq%PA6psL7jDdt`Uh<6Q(Ly8H7T5^c79NepvacTm zNN{9>Apyl88^bg)fsh1}KyoGJX4kfC&pvW@QCNO~#1OLC1QNpL=C$jMH#fVR5Z&*b zQ#}vaPFU{#asRk}Or1V;x~jYC)Tysdo$67oY^^`)_HW&?Z6Mvh-Mw|!&TYGPx^LUM z-MwS$uI(H9-M4}7{%9Z(x%-33ty}tU*wVLi=MCYZo&DR>13R|eu%&-fy8q4_h~BlM zfBTLbI)mPT#}{a8x&E4~D-s1|Y~0@8x3hnf`>HEE@vXOemR+&zYWJ1bT(|tH>y}+z z(dJD=r7Bx2v1@2k-k0;VDi^o6nKdZUX?6tTMkQ`2F}u4^ zWC_UfK)5r=HyibtgTyKA@cJX(Rl&@`S(yVP6)4GOjAlmWt_^mYYdwB57Bl0XXgJZ4 z8F8RVGY1{G)zO^@;u_tS8F6yvK_^ugT-#xGc4bD&>>kLB%<*-HqX8{QqG8Cmqr_YQAkWCNT8B8RC zxTy4pyq$?)7d32Vq*Og*2Hl9~3Smac>OI zJ->j97 zDzI#Z7Ve-N%R$Pg*FgD7p;{eyS;vLAsIt2p4VWkaqnsW$08LMj=I1oRs3Yxzx*Qs* zNOW~}`@6c)+)%(WQV4zxs2{7^fst9OqCFiU%ZqI1+Gtw<6yI6C+S?hXx1<{@V&1i? zqgb*M*Il7-oOsNriJQ=rj&OWcUhH5sKcX5>R7|Z>$bvrSyXPxDJzBocIcuhFOKntu zhjb_iWrprCx5{sJ<1)sjGiNTpTf*b(@#G)tz{orrgmzE2poQ?*ET3yZzPgy3I}nV9 zV;D>U8lf^yJO#H@uu#4Y-_6M5(p}Wp9t_Da3dMVSNbNYMigPe-+q{0_z;>W>13^DD zICvfCs^DsGw3S8?x}WoKzu)ZWA=*6qt0=Ib^T>% zg9|UsjU10^dJny3S5HSUgV9rhhV2T*sxTM0V7@#ZWW~^*_HZk?7CG}t+5?M?$tRz+ z97bezK~Avqa?5uKO;fqMJ*KZ6GfA!G(=DH)F@vFmUh`?xjU8q<-WBX*hGBh-Q>RKx zsO{007!rw6&M8wl6)LS#X|+mgR9dT2mrCnYTCdUu>th$-F|3c#-^@Y7+KV1s(`OuQHW8R2NMWkV*&(+{MbL#F)gl`hXuk>L62QV0Y=2{*J6|o=&rynzg zjPMH5xnO5kIGEu4k_68T4%g~tRNm^QF zSR3Y^F5%)145P9Vs012h*t#2qm!dM&YzIZ=AjuFq=o+?mD+$${O5%}WF6>Lg*2j@w zjS`9*S&1Fepe-n?l%8!>uv0VSzP-3ea)@Z^3sWT2CgAS0(_DItW7$LUB z3)!YJ@D@WmlSDxUUH_V7L$38uDO7w%&#{EI}>vuGA}P;KQoX{ z5kL3*jteYb6a4NT@a$CD@S z={r7f!sg6Mo!rxR(!Q!p_Eu+;y*1hU`#=nUD9EWrj*D_?k>e`NsY6aZ<E>voX6&8DAElpjpdZe~kzfzBo2L~@$qFJZoKkRE zFrm;@-d5pCO(sN%=>TOJ=}UkjKb(x!vHINh<}p;ur_Gfu{Ul-ecHuq zTcgHPi1Vo*ahp4Pz z)X1_bWPECUq{_OZ_<BDdPZmLCHF%S%8+ zep8yzYdGrwGRlH+EYf*-#=OV)H^aXc|31#YpN6c%=UaojnUM8tsn568Y-_uMxwz=b zU8pISGiI?LK*&6VEb%7%=ySQ1)}(yFl|4nkPX@k?{q$1QTgop$z>mc~4;EYfnl2QwwLuBZRzkW4A=QKe%<{EW3pn~J_nEFkuu>k{Rv}f^oFX||QY$%Izm%M^ zXsSF%zT%wnDZ#l#1v(+9Iwz-@P|2RIdoJ|A|fz&01aM*q8qjWmUwDX@5rJW#$fmy=U6dR_(igV7?Rr)Dh-K>>e%U<3P} z!C!guBmusCeJ2Ny*ku6()&LsS5;Up-G^#DkaUrLUa$Lx%E6k}!P6OrCBd4J-rx7_# zl+%curotRIau!mK8#xOLa~2_IG36{m&f>zHCCF)}oF&L`h|Dqy%$0mGFH46Bh5ca>z#+DFZmW(`5Z zI-*k>%$VQnnv3|A+kh2LHavzdwQ`%_@?Fkk~VdkZeIf zs@VjT%q2wdNT)m*%AiWsSk>mzXzHiI?sTyEC;)#6s#tHQAD%_@Fp&%i^$?L4vA`-K z9Za@?)PBZfkjQT_86fiOO!|rZG?P9e_YkT5Xfr2o#yELHVBrr17XE-?q3$h)g?gQW zg@^xdVc}E>^a7~vzXBAtPBo(cQCJiDUqM8@t{5VUi(7BtSN)YhLOnLm^3S#ajFe?M zA0(v4DzHYnfRodP*r9)c0TKYHuY8vP@Ll;RtMdSmJO+4%^W(n&2DV<`lxla)yo4Mnz6RJt>p0phkTS?v~wx zd=o0fFi<487J`*rO|E&BT&hT}CnuL{dL=hlBzF_!D!4qmTa;M3NbF{a)r#1RE>q%L zip1AJd>)IR)tyRyNaKc7fN4GC=dgTHS1Z}AMY6Z#WyybTtAUc;RwUaC*|}Wq3>8t* z|E);+)^kad`Y7q`!~D#u%laTKU6xlZCAg!g*bNYrwwtMTN_=Ngxf>xqpP%_0Dyi<+ zRdmOuv+l^NE70V^P?2+yiWcu8@Z-kq1KW0P-A?bN-zJ3?z`{Gvf`xa&e4QH>!m`m` z>AUeJQf1u*hVXo_5VnkLp$!W+D_HoP4dvdOPw>AE76NG16Nt+D1i@(_P97kF(@31W zcMzN=;=CKE2-!s>``-M7w^AEl46F!f*P@_Zi-LA7HneN8p zU^^hX7Wn)C=K%3q0PzUU0p9`3!S&Yy*B{^hlkO32}vny zNAODQ8Bt=fK*>}AqIjYJW5zTAPQfI>S2^2&tHSAE?Tl;kHQJK{$l|F1jNBApPYi`T zdz^_Ukaim@oemmc1wfGBR{tuYkKgb(`wEe7G5I`^Q%pWbiB(GaBGWEQ13YyZYf6xsOO&J@!2vR;4k=TBYOPeA>f-E6mQaZnsvw+sC+I z#$(tq8->ro8Z%kS$#GN~((#WfWzGpJ#Fa@ji+blFT|3uHHx|}5Ga#g($_tCDtg*s6 z{vl|^t}=}MoT#XtV-;=TB#(Koa*qxSCr6XR12-RtjJZqjDne(XWMu~lyL71T2txzCs4@+aQc zF8qV-sWZdLN7^?yvvQkHZu5pNoJ3hYPmddqrY2LzQzwR|r%!Uh@FLtwFMn}w4crE1 zjrS!O#9DX}($i_j>w~ZVn4g8S;6N~Iuz6x&8wHGF0lo_YwXnDv37lO*3I&iWf_9$B z@j&}bVN4mct7JBDJ)>hoW|Q9Q*5O((-A3=C5_-0&2KW<9MK{8WVADpXAYRvpz&G}bMdL(rIS%}$(hmU9&^d@nAv=0G`7cVK4CT)sCR6{tl{#b zFJaLyWbCC%o18N6oGE%X_mHli869((^``sf$V+%V_uwgHjQv#IHKpNIibZQ7>N|%h z+RvGd#!lh=Bfe8+!ypHKpjA{+*pezitB{+8T1Ix($gx8EXr`N6>A<))ZlaCQQsCiT z7D_YKVNNv_EloDjZZ1lt%sSI$^J~#$DQbum8sb#UX1h+Ai@0o+FdX5Z*`h*t_a!fz zE_$O{q81a?NR+Cu1O=PTIrne94#X64yw8Z!53_@KxJ0yj6|ZZmF=049h^>@d;2s#pTWX&g!F+W29bBr2 zKnVdP=HG!?7zjwbZL~KRj0ZaC!k52G;t0Xi+u0brLgXSUV4XLLuuUKSM~Ej*j_-if ze$0|gK80du1v@*<&H-kgT5a8Ug;4V#>R5r25cG$5M?X1599ZQeG1$?gze?omkdXL6 zy80{0e@>EvlH4yzl%A@<8A|d?xvuXLDKjRK`fE9^{$if|i#&M;m#C*Dxs?;`8z{fl z=_sgyVStJ4Dio?6$5y9CyV~002uchO!D~CP$(`%2>)g8o8xhWGXHc(#mq3W?0-NVg z_HFOmh)`blj{cpL3G*5g^J@G-?eKYrldxT~z*y}ZPls)1#3>~@m z@&lmsPlCam;S>trPgey3XIC&jeR->l)_R^fl9S2f-cj%UAz>Q)hIkg#wJ#(WC0XAA z-&j;hRHb0`g!LWVn6iQ)M^Mj6#-Hc|$6c=a1tz$M! znYHMaPnfl8&Yy6%o3+uwQ)1p-*)XhPEnmQZCL4xn5`;pq05L_Mh2QMHa@HUybs5imJ z@mmq+(c@ezwb@WX1 z0K}QJ)>86SWK^vSN29@2-e`-rlU>5k;yFq+_ONC2j z8Rm$7e?~taCZLJE&Ty2RUX@^J(_EeQYgAXs&ynbfA&&bdT<1cuBV58ie^3&SBu$b~ z6tl!`*HR6?$K`ydgI*{f>B|O>a>*7tVx8Oo_ky#kS|udQF!29J!84EaryXZ3Ook2_O8sf$d#TgU zq#YEVc<+{J*bFtid(>k0NnYeW;03nF%tshvVp({iEi`!grqTAjp@Gu}2ak+h6H3wL zy=-F+rjCp)E*SA+3kohCD4^5R-nU*ohUN3yldX~V@Mvf_`MVN~5z|>bMw~EpKAfOY z8=DAyT1)|(X532$h2p_A2$5iz`k-jy$0ZTh@TqE65eJMlb?Y}A^m`uy@O`m@PT}C! zyD}rQZMe$86kBiv$Yw}2XwD8a=StN`Hppu@k~*3?M(ZCeAnQZz+_9*s#OajgKjte&Z0Z(b_B)rfl*6R(g)% zVlp!L&Y6ezw>%s&H);&`q)K|gaI1!#q@JaXKVvc|ek9`=A_*bzq zH4*7%Eqj|tULP74fzP|p-5C|SRBcty~tVx#a?@~)xgMVH4F@= zcGg?~moK;LlcI*Wcp|Ew2%i*CGa*~-a=}B1-xNwXwkpEdqZ&S}eGyrH&X33lKm8aS zc(erDo5V=Fi0cN2Ybz>bI1)oq7*}z#dOGl%Al!h%+5duhsWx#T)_9d;=G&G@y2emE6B?dOl>RhMh2pDS*FdRm&4(S&;jJXBe=THNbZ2QXH*7cS2 z1aMX1WP~)CI#%ecLq-{}4`G$WT&t5Yn6X^9I`s?5a}KPucumNp)0(q5g^^EW9;NZ4 zmy(S?QV8DpNt=wXmx~qO*T-YQ=FUnU-P5Oz5esQD#zi{N@7p`3V!kLR-xO4G~xH0^~afx4dcCPLa z+@EjZJk>tCl-dx2I5dFYMOk`X?g5t;av6h6hCDbpO-Fyqo2e5J-_UF&W}tvs7}$gd zS%G*54v`Q(69@iCJLp*QoZwoVNdqciUG@qlc+)D`go3MZd^*4b9ffzZrhU7L?{t)t z{(O&V^7d(`P*lzxH*Fc{_Ggt>C%)z@Br zbTe-7Po^i*ZT^#B{uvD&uSZJzIrw6Rd z3Lu%7p9)RY0h2t4ByHHJ)0Ho~jsp6}9fB(%#195WS-#YHdFe(Bi*e(Z=gD&-@8$F4 zRUq$woF}ged71O%RU_|X=gF%<-mT}!t3_TQmxuN6cV@QDA-pYZ{!FAWihD3=Rz0<6 zY&8ujY?4p51AFDQsUf>Qm1Hv)AJ?Afq^E~&_V zN~xb}V^klSs$lW7!Oc!RSD(FZqM*Sm5NA2Af7HG+G*!<}0p8|w?KEM@S96%h_gb>XuJo@G~Ez3hF+agrmT5@*f3g9$$UPP|F*N(iuc38gyO`(Z32 zvXVU{PJueaar~6Z*XxMg_~Gyj zf}^&hsDAB?MTKZ@SZgR5r$GJdZ5;xxs^ijGlwwh|Z0}?e{7=28GYJn5= zHkP~PMoP3%zg#h@(ofOiVqO9t;J|5n^?ET!^|YmCjzVamV?B(N;q7Hb_g8pyUalZ4ZFckqAXsD zTHY|<^)`WS=Z4J4P#hj9SyHw2Z5c@4DRg4suKpd@x!Z8mmKg4ifjj!sLTw#Tyd|6Z zHx6v0%N>{PzI09hz~&?i@4hsV?h~2amj-DGv}0iFkd%vB9hYZDuCrHk@K4CMay)Vt z!@Y6qF8J4$?Dn!tZ9r`W!UMKtV8;%)(#UycyqOsZpQD5s{gf*!a2dO}*g=PH{%lOT zu~SILMwaXjT*d`HlNky8Ckp(d4|lKfhfT0~R5lXP2W)fI3^Jv?gM$GFl4BpoM5B-l z@m$%78(>_gT(m};xUx92K09#{W!CczG@oHo#3jvW_a*O5@|q6T9JjLsSIrf&7}j(9 zXFSbOvaZf-_$b-euv)-%8Kjle%z2|ppYZSpVKlF~is9;KC|{hw_c8hNkFi=ka}!_v zvW*gB<7JY}=VSwYQ>aqe0N9O~#!j_IG9w>2N7HZVOVbyNaO7JZVC`Y0VBhH;EV|X= z4xfNA_Ph6&!?Mq&E%@BG6Ug)$6r~B6Y1jxhwXOVUw%1SIcz45S4 zAH0}Fi~gWaxPO+{2e%FHPs4FDf-gqN{&a!v=06>9F4e`CsK{fyy>Do<_--GeMH_4t zK1)LIo`b)umDdBSjs$#65@<^2@mK&FbW z&>(j4w172s!HCzW&#B-uO5)L=jCN$?{3y%8(f(ChP2yEUQ;SrqaVOqBv#FSShwkJQ zF|fVz(H&kipJwJ>T3A=)JT=P?TV1GNhrKL?%h))R8B}mD+dl}0@fXvEEJ{Bq3QNvL z?!#7Ffmy-Xch{ppC^Q)$l=b<1OF#>%U397%&YY^;bV<8`)F9PpIrTvtXOubX1Ejg= zA9Ab3@&Cib)}E17mqWi&E}esTulHfBLF0JX@k7cGD*!NDWEThaQFXaNR!;LPhS70ykLTRt@ATjiZauexa}|HGtFFn6=TIBqf|Va z;}LFiuYfv1<%OIoe!oIa^;w*nvpBWP5r~(IU9izE?UIMFv@{-*-M^audW0S1y#$p-OmqT)#dA|8~u5(+9@&>xfeEVlL@g zjp7f4eu2W(%<6O*H!H%+(uUda8sgHxljV;JwX=iDQWR8ILlI<4WU2HG9-`8H(l=(K zwCvyU@}>Ep**wE?t&$rd5dZYhVgrE6XVh5MQZU&Wnc ze`792UNgPK5^$Cv%bB}rU@E$VqC{Le{nnZ;L?hPj!Sl%X0lE?6R^VW*q|H_Z_f^DO z0}b9FtcJtuqg?>wFNlr?2nrfUK|6gtU9=J~c-H25+(>~xo4@b`KRACMhXmNIYTQhu zm#xG$B0tFFEkyEBG5uE{_1_a$$nP`xZCq=oWrguG=J1;1yF_Zw(9a8bF7HVgy~I6C zT&`666qC0S_Y+L^-Ob4@>nPDn83P;Z0?b^uOcJ*wvNN}iAcJG4fc>N-U6RBlxl)o3 zNOG|xIC@L>&6R{sBh$))76`IF_&3flHjxV@2)*hQpU#+y(f!_AAQL3 z@$y!C^8=ReQZDt41(uKF?X@44()Vj{hxP*ke8%mWk;~43Yc}+4a;FD|`f;q=Eoahc z#XvW#P#BMj_(^8Odybp=?6*7FC!6pa`upi4LVerujm{PUNc8Z9O9<_+Gb7FCD2VYB z3lCt`vZ>!Kr^=y{t7THuzJzUV;1d-H!}hDm@%35BBYXOesBhlGxHg2IU&Nvx;7~;Y?3&y-Une;LeVsp2i%sZeyZO5!G zFNQm1xeZ|ic_A_hpZy4Ta?kLP)SqVhd(d8q1j8BPTqqb0pGYiN33bEcfOO~ncqHW> zLhiXfI7xZ*T`FfN7)9{^HY>J~YSd4aQDQhs)>uASIec{`bH38d$@7hrXy4-jtv}7! z@*aE=lyEKuSh>RqcRUz2&_R+f#@aP9BkIihG5B7+-KZ zPOM?)C&g5XP>NgjG=d6KlLfa$X51`Yb-cYb5@pD|_*nGe;eCkSn;d&FY}}h{MYpWg zkA{q!^vQN(oqi%}sDACOq2NEW#^{C3r@0uju#U;stT%ca5uuG3X@o%M!r672t`-@+ zOLUt2mKeQDbsS|fmm0lS=s4SMUI9f}E;}2V z)Zf#XkxFD&n=b!@b)o4tPI}iNvy49li^Y=60!>$g=Lkl-npk9Vf!x5hN8dc3O8*G4 z_{5REjmfXj^#GI46S;xO=ZL(SNjh<)cQHvPj&wO#^hF|BRrP0yWfR!xJfZ?fN{%X` z>{w`GS-LbN1CFJ>GnwwA0FwJ7>AR2&4}{g|Lyg!mm|eLn^Zu1xXT;$i@9O!CiHHrz9&R5kq&10x-1S z!kF6M_ND88!Zm+nm@eL8`4@=%bMT9I5Cu`aa3{-rb2IYQ$AYgH&ik!ElNFe6;Q)Pr zpXF8h3@iL8JSP}05E+*Whz!DVm&tcNgZu?uV}Al=7Jlg%QsVu6nV#q|`pB+)H&O~K zC^t+`qdsYjyG*X;HGJHa9XcZTBGt;{&0tcVg-IXFPmzE?KPKrEgM1ztGu;B73WnT# zsCVmzRR2ak7C_ShoyPqD_YnWECdn33p2<|sU$hXL_;8-f_pu8?7u*YZT@FvsLcFlO zm4B&qeT{YfEH`08<#ORW>HEfI1lK7RxX!wPK5y(I*F8h{f?{>+1|46Sby`=!n}V-n zTjl5(t4dre^erm*D2l(DZPgZjy!O3+E!(<)LmUVw{QnPRpYH?NtUy()HjEm`fS&cO i^}Igl)X!z=Bi9KHkxS^o8>~Tajkw9E-7$Z9`u_kGJkw49 literal 27572 zcmeHwd3@Z}b?@)@o6%}{JeJ2o7D673EQI0_wgF=ZH5$$Q>=|ihenK;{Eiee#Rv5`+ z+0P3JO>kwvEI~1rjbR21q>vWckVX;@@IK88FNtb+A&J?VE=ee)bam?2w0$jczvrC$ zo5f2?($~-D{qb1lo_p@O%kM7do_o%@S7TcF>OjOB*tBu;U}|8CchmN5o40TCerD4a z@77J*x2zlReg=5&=Y#RiyKhKt+BmRmWB;~o%fiFk2DYRIw{BjxabSIF;I3r^Z{Iqw zW$UtT(;xJ;2bZ^g`l@Ry;{|1`+cMCS3m08~^>vlY z{qcxYWs|KMSU)_lb$$O`3y{N$90MEIqJflcfy#Hy!pbvGr5`gc+oa*2J90nM2%0%l zXLJQc+?t`M_m8@kha+YHElilfh!rrj^dqD0mUzM+3;Mf*zHqFoC()7~buaR6+qBu2 z8n|;HMP0GcKoRLZqvgwcVu3{1ilz7IBgQ2t&>b|FhhwIX%0>3&mK!BHtu8ZWOhblJ zt0#dXO955{!`&ulHfq!R2vgSO4|MuhnCX2b>AjeGX)G^u$fXF>>iqCnxT6Qg!C)E~`6{9xb;AAw4>yy(b(AQbAo-Je)wb z%T{$Gq#^PpEMF8oVfF@5LB!v?+=?amThjY3MtRf1$kYu?w-rr~8e!B{+8$1{M^Hr- zfT+JqIx`mync)>7q)wC6RpDSFlpd{YkKj||A%76nmm|9Zo$Xd6h-7M9w;7L{h)fHF z{M~UgL7kZ%EmI9kW9ZPfpcxNzhr1G1cY3sh5a^Y14!bRYB|Ly=WH{lEgabfCq&dz= zcO2~~#m9zw@F`{8=8B$(pGrvttQaWEdlFVOU{M1rZ1BeP=q&E5c%nPpX;M8j&cI5i z5u%kaF@F@;*#%h6)=C8E#tIsZguk7#@|f)zb+-HCW~GiMeLl85mAYHQG}bQ7&tRUp zJdLvqUL=zk^J4K?Q*$e&WE?ajbvI^Y8RlCTdc$!sB31T0Ko7@DfvBM71~L8Pv>bBN z#HgVui8-`?v=SfN6G-%6JTNQEX_oM3U{3P<+dEpaBGTIx%CsZdxjM2u2#9l5tn_z> z=_@H?Wz@e~jU-b}Lp%`*#|Xy=cg(`{=?ceIvEP8A~v_fzZqS(Qu>}LBRCI!#86wW4iljOjTC;+_nvKV_TabD42i8^`dp`SY%Y&L(2RtmSad;J$+Dh&1z9SYDBrC!uo%N2!^h>@(NMH( z&t9-`uI-a7Z4iRtVDN)x087BU9&nYp(jRG~Wk~az(ol84>gpwSvmZ+h=s2br;Iepc zJYxBS3dDj+fGBgDq?S_>m4jp_&zpS)hH)kp;4@<@!`)Uair$ZBrWJB2uEj~yRuzLO z>Zc`=xp5j{9yQXVp7ZS+`$w<+HMb^SaY0^jg9WRN5gg~AR4pT>m(VK9=GP}fyguDp zdbAq6Tb7O2UN8Ao=~$Mz;R^J@#q)D3%cr{DN1vJK?K0C?U8U&Qgc+^E2I2w#^K}s$ z4AL}_Flo(VYW)BCDu z)B+j}W0w_V>^VYLc9Dy+%eeG#h7 z+)e+c_ZgXc&__E_TJgWAq!ukVy5gAtdTn~t-zj?)%_f?=RlquPtJ6s~A z#42pJRx_e9YGPFeu&v07t)%&7b|=E7ESAzZZ%<5H8qC9Gf?vc5Ws;yGD_5cqEn#4# zyk1dM#zcF|?V%hQAx62}hiS`SxChOxv}c8{3xz&1ItTN`-xEpXM-W^|#sFVT>yCG4 z`Qj06gh#8CiyIq3{!$DpK6E6r1BI8NGSwaXgk~?%kXVoy$^4e0P~D^`_Kk31zbnBA zXj~|zxC0gGqZ&pX<&{zUR+!zIA(`$)rs>F3)X6H({-WaVQMRcst53hEOzF3^O$$BR4febY!C%)qXI>!0Izstw84ao+>RL)@?kYCkNb%I zSX~KhYB!tR@tGi*l_#;=42h!%pKHJ4qD-KQIgzHmV-LOqeW&l?#x>|Kmn9D-58c~; zaPUwbb2xeA-u}abNAj4X$z%8SA00eqV@igO@9aNr$EGFwT-juwJNrOCfI$ESDb+~v zP)apYJcTJWNU5ci8l=<~rqm&&o>JeycU)(XyQgJ3K}swJq#QQ=PS%32O3qvep8ET0Au< zR?VqBwVH9y8T_N>)pU%jv#HbU#jIpjOd)X?goSJv(E=t+u{;kzOfg`BWJv5krO~5cIeZ%ia-2>qL-Iz{SQR1 z8F|r*CkAz^Vq7G5Wjc=aW26<%upVeEcj=bdLOS#{Rf}08xchC!;8xq-!?8=|Tb;T}7bV z1phlFoKX=t_&|{v}^=Zt^L@vLeF&141=8xtWP6*_%iXZuR27{$cOn@cO|!2iI@!Pq7$w zN9wN4$yRT8cwK7y`hl%bf^Hn}-r1kp4tQOEYTfn}>o7?_%8JUt;XAyA$_d&>{!PC6 zn>jH}pLVvGrqkK+{9;=0lZ$Co*+=-_=6LnIP)^L`;B{F&Z$Q`r(;}v4?^7QuVe1#n zV1I34t0H-v1gu^C#|IJEWkKk2LwurIZCoY0agS z4fQR|-rJ8K`wM|tOqj)mn5zkMbs=U6VV2m!+fowVmMYM2;_X+WT4gpV&N7VTv2e3xg?n-H?{`wC6Aw;2C6|GvY&@AB_^prl$^J*AoNVrfM<%$XM^KOPN6>)rS0bWbRV*TkYFDr0 zPkmoRLOn1m6P%ubV5B(Hg+xN?tO9PNi*WLxA$;hkU_c@O>aCwp0IdHc0-!4|0MdaQ zZLqoFx$++l1(5$tJ!6vm=OX#cRPvvxm1Z}rS})o=_})>s+8|$q)dfl^)&3kdFQoCbW1+ExKHHWV^;=PH zDPsyn#tIf0rGHpr#DMZ#({GavSR_V0iriJ4JKueZu&;F+C^qiqo^y@Y5L=n7nGNH_1 z`l4Z0v;#%7i99XogY7AxXg^a#+XLE}T<%%ZLs8#RM7{ES)HHPzb#jE;tcGh9sAahF z(@GHz78Sc1gw@g+XH7XpK2%h0FUV&z`FW?aS%L=c%TvovARU}_SKw# z^K0qe{_lx{5U^@Vc*^VEfT<%)UN8ivo-lbW954-p`6MDDXd8+4ze*nmk*?Ji=~{Cl zU8{(6ts>7UU0f?mb7^wH(AarIv#vr_^%#t!Js_X7Dol zE=f>|(~(#u+XO+vtpJrUKLU{7AP_lgdjO_jbKqExFCbR94Xi#ZPI^ImQvg`JB><6Q z{q}}Xh_lz2HiH%qSWHC>Fip4zr0E>D0lPu=xPq3J$XGF|PvzVtpZZDk8O3d5+|B{#|a=pH} zSg>PV=~;5!^RqJM^b78VCyV@L-b#L4FTv1s+(H3B;!yWn;Ia3=)5BftFAMP;p z-e)HqcMlyNIx=*0_{^DOOmX~nYW>_k7tZ^Z3+Oixx}g$Cok=;~-SF;Dc-%P=+5pQ1 zerVvZ3q&yiPPT3$aKnV55y8173?ZG&Hl#%$BMs>c$RtA=f_AooO?I~Tc}l54Q*|3o zf~*tT0ZU=(p(U`q*1XeuE$>ci-jN8!Rayhl&9l5no43>Q9v#29UApzrc9ilke`&jP zU@}?P=S9{q_7BoCSdILJdndGetwx;?^Q*a6QxuHrxQkf`V~; zugylS=8sR0MR!`w$6{9V>9H7~;~mz5lYNU1cUrBd$2xaftw$o(!qa1soz}vmR!b9o zM5BSWOq}_gk*${oJcUad?kBxh*I?MZJ#~bKzFFMSd z9sjAyHKn0f3rS~VXuNM)H3hUEDq4)GGus(CiLvOgYED}98`wDlLu3=w;v^eJ@uae$ zP9v)r*}p8W-Ff4dSMQrA-BrWAXm?#BdQ{+A?$x0otJbQvan;b{3|TFw$A)%VEhi&3 z+H=xs;-Xc+(v6%bWf<|{&2L)O^fhjR8VPD3NL5yff~^*v(A8Gs$-Wkvon8YUF>$8T z@=PY|xl_|OkDAnB$E!gygsDU=@}fm*ilIgGq(u^()1vVPtR9rJ;pC82v*9iDr?j_> z<}-TIodkD})@hnk8RAOd{>NT6qs{;rWEyNT(zC*6b^AoC0s~AFnQ5(+2YEB9ZBC6{rD;jvpZ}-2UL@7%(aRKRE3T0*@g{Tn8!kd?rZ2 z9tlPySS7*2e5Ow^_`isBHYXatkl?Q*_%jKd1WPLC_Iww2~P50n> zZ_y;W-n%3ITd@9W+O6=6wMl5!QA%?`wm`CfOaD4J279*-Y@$jS^0qcVuMA$u zp($-2{{LbT$^gnJMmd3U7NX2CvoN}RI zBh=^}=MXlD^0>knZE{+`vO_jgY6sC`ZtWj$>^ldKs$cE0-V;e>~k)=Ev z*8M3%(tTk==RT0}V4-@Ss6kE6I!b{C6L^h=0N7mqMsPgek5lZ4#`Y?)w* z)9SZy4}3tNu;>#6vPEA15rNJOm8N|~f~Qb%&a;~EyE*?ypO+vhL5~D0KrHUq(?Dv7 zHk^)RI`KW*hnq_Im^1t}foUYE!J+6wRG~d=cOt?=xsCu*PLe~Z8tjFc;M`1LW+qUA zd`1-jmP?%jCR^Gp7Z@w}Q|WzJ z#2ZeEi000QN#y1TWQ=6p2uawGcsz5m5ia;>)HpW&RHtz`+=2Gd0nWXmJrE}mg62M1 zR*{?B)ye`9D-PFjay`SjY}83~xm8NzrTrZ9(i!o`6BMCEFl$YiPJ)q0!Olc!KgdKW zc#3Dt)E78-U9Uur*-nRDuUrP;jSOc;(Caj4`acn9VEeJu?$bUnbo%)X>VTFUxXi$@ zDG7hFBs|FS{TL$7-&eiQsvf^cV9#F5vn#~=0Hr;_oQpdp+r~j(^6<>7gT6VW+Mu0fNzkw>JFN2QU+(8Rt5G`RsnF*n&OO~wQozev?`cHy$I zdkRi)R*h<}hQ{fAwL*c;;Nhs>Yt`Rx)$tfSX4UB%&zu@bK8*(GeU!9w;~AW2tU4~@ zsiCk{_x>wZUFysSubdf4PF~A#oJtsl^UMaT-fDO?+eWBbC3Se}kYLqwwNS%h^5a`; zAmk6yI8|pSelgw#!P}ZyY$|nt^N^3a+>d~q+5}}d_9VJv5#dV&)if7>LYyUcrGzlg z$do2fWI$%c*MY8VO>`ys?NZX!84g5}1K>Cxq8 zYGC64JYY9{#+&OtZ}X1$738KdylI=aKj&J%0C9+z+qS^>Lg3B)+mgfm8wXmcw7Kcg z>n>c{`b`5{hcDme9r)bfR@AnIir+qrn`!I&*QU4t?FZ@6CAo3^m8u_3k1ojP+!6Qw z2esi!Qf>Zgb03PkblY0Nyt;&WX_K<@f4_kFKvLpGimhPvp`pVa#N)>s!#0}J_-9D` z=b8@TP`>*eTdZpFDnN}YX^eNZVC2K&1bC^o-ZKNK=<){k@;YxH9g<2GV;F{96| zlS;r%%p44Z*mxoqC?E4d7yp(2a{C4wS+hNC8^)!!^3`SNy_`yPHV~c zc*0z4U_)QB*IFXt{V~fmxinQ~x&Cv-(Ee1-1y%ni3#x|BtNK*hs^(7yZ-1Nt>e#vs z`~^uL^=U&cqAWaNrjwqEGHkgdkfN*tg|^_u_1$WcSc?R$5-gVB>giCgurvKl^+hw7 zg<;}j6<{)k$Qrj2zu}o^Mp&LfEz}HVWkEqYJbOcjlgPu3_5i?lcLY(QyxZdl~4)f$)nwm)$PRX#e|c} zx`l4CJ!nF13i!cbw=bc<0g?HKdUDm9GOsXL{}Yvp3p zq!Tb>=gH?2$h)b*ptOg!oPB(xUR!0tk%rsI?f4Rd?FTa5ib*=Y59Kj07~X&oIoz?~&&Dl7b)eh(@CQBoLz|aXEB^gUx-OFo*9Z^6Zm3` zDi_7ia}ex>Z~v}zR{xH?)|=6 z%XP`v_#CL>U3Ju5HAU6XW{7@2!QaMRoE^W4`=pQ0AgMD^NDXJ6IqP%2gdU0HdxZ8@ zHw5rCWcjhG(SI1=cnCPyhj7!us(wZ0VSXC%DCeUL<)gfj_IYsPt$7t?z~WJz9e;r= zI%JRD$ht9Fh(bEqvfY-$?+7S0O?Bk0(# z6*V_vH#hQM-rUHq+T5d|NGB;BAhLB&hb~*`*qq9+Knq|0Rn=y7$m9^0%8v<5g3mZ{ zhmE#K$2#UEmlDWl4}-xDkj#`V(iiN(?PpS-#fgYDcS2Okt)U`~LtILT!2g~r&|m`q z(;81QHcSK}a8fl!9NUcC_@~&FTpk~-#EXDU4)<}+4iM-!=D~&Z4Xga!tRs7!GZM9U zjvBKG{4$Y{9oph-mkN`=l(lWfrB^U=HoI0Dks4%h+=dK}fSLAJ4s=CbKia&8-xV2v0C zK9t}npW?K8n0n6bnc&Jypo1f&H=^5e40q?*t0&<+kiD&J=U7LpSCdd-++QDsGk>i@xux?RtJ@j)s zcEFkKZSTL*24>+GzDZkN9bP%`$&G?=%)XcJ<0Aw{LJr2V0pgU7L7{gY#JLrZKLp}T zD9TTx0~zua%J{6wA@r9REI`PPzUBaq%5?*u+uT3A9#^%`_Y?r@4Yd=@dw82{GoW#5 zGYsgQI@G44{eFjjM6_%$A3qh*kA;uR$!b!(UnRm!l=l#<)$tWz;m}jL_F67=KAW7~ zDQxi6<2a#_;-7Y*$xFCyV7RuTLPk2HD2h%omTOK{PJoA`RW~#Bp3z*(j!vBE3mL>B zXh?1?$B$wYQ1MkYHb(t{Zc+ty<7JImcC_HK|1@ONj$_(51HmB8c8xn#=LPgNE_5wn zf0sa=*0=TugC7#Oi$Lu;o{IX1Z4$eRCLxx~Dyuu#)yTwC7fIl}n-$MJnX9rd1(}9uO(v5C_&o z`Y|0X*Bi;OcCb*t$&G9Q*gi7=3tW|6w9F*wE(W-%|d~ znck3E#TZ5RSQ`xr<%Cs=+H6j@}!!G*l4bge{9vn(ddSg z$Hw356!{Eg)D^f3&D2Xp=*{QLLmgtVLl)c(!EZyB`hthYqlG+%oESqsy#B+N5nE`4 z;G5i%Nt6}q@=CxZNKr*IMPm;-xRkbAcz}XtP$ii240AP3FtDTZME8p>=D?Vhgr*@oF0W3Ne)*mW2W*!4LaVdz zBH9(25;Zl~)vI%5FcTugUDv59uB3kNgkufNA~x-5m^-Tx=bAx@o3B$OB z0y{|PPHjHMHDG>DINWwY$P3vnmp2-k^62!vuB?dBle33HQ)EAR7(vRgMQKmIR2SXQ zoiL88&Tt8nm@vMUFLhR)+JmJvVT@fM&55+_7f7o_TJHtYs*v^@7f5pk9Y>3Y`qrT&v&v55 zE`#`W7B13Gdy#hfc$AJsqI0sc4ILhTK5Sq}jO>?+`xw>3UdH4pgS(wZ&Yit}vY^8a z%)JR+PG6kC&8+~gs_^6f-u}4SEbXbid&A@Pp{ZJ#1cZUrA7=U5VzYd$47NSIsvByL zMsWVbHvVYGG4ugabB(LXs-vXLF)H}BvDgD>7$3AA2OtX8X8;*G(r~im>4-QC9($AH zp8~|+Jn0Qh)gki!E64E*u?U;^2JGUmVm{Z<0p)l!mg~dFhPSYL4}}d(_eXLczMq(7 zX?Eh@*2DHVxoVYLb+D|TDJ`j5Yk%OBaVV@SWR(hCDs-x_RE6c!bDg6w#)T+I*IjQ3hvGM_Eip^PR@ zms5&VwOa|i_~l!)WYJZN$U(^YJ1B1&oEtB*V!47G(}H zRsmDXH-eO@pWiy87i3I7p98{_g&&fNgk!V=={Mx+);`FPIIX>txru_`18Hfzr#)_R z^nkQxI|pT(k?7`f_#G^%?KV!^6{bMj6Ob6oRr-l5kzrOGPsQPhC)GASvarvWvCG56 z4_1K6NyRp!2>Gb_rHX&?Uh#36@CEDnXM34HDqx0xGjYVt8)= zF~?6ZA8xJFLq4E4UK2DuGBg8L>27{Y&3-fp1p2=+ zfqsg6f|aFzE|`;yp&z(&P~G}L#<1%2dBJc`Ypg+4wzCnYd5p+63C(({nwnem91juT zMI;JDNZCu^e8y=1z=b>t3@$YijrI)*UO`#xAed<8pV>CxdB3}tdMTi(BMFm;!} z@xk95!0~H2UZEj`w`=fo11W(v4Juso`hj(Wn<={WiXHP;4Gi9qWa1t3T;;l?7j9{E!@GG$@Cq(4ogNMT3I+bs#@%U~>6nWu zR;o=^Gapo2z?4QCAK3VB*;^N}UXrgSmjRfnqBGm%qT)n%cJdNR6b&WqP1xWNrQPZN z?cXf$j?iW)jcaJa?oA=V3)#S-vhRa7Ibz4mB&^i${Q z`;Gl6dTJBTA;IsT-s$S)SwX|4?Zl~Fo%Zldp|RV$y8?>s>EuP4d(%s!25i7sKtMED zCWK^?JEge-se%4s-}cS?p66C*$@w(P8^Q=K?2?fIzAL6q?`W3z+o7$}s6_qh^eA3C z6~D-W$(w)n>U?t-uc(qGdrSZD9b!`+rBfU@5sVOIy_D;i$~uXYhFsCS22Vwur>c$H zVX0m_a0lLy`t0Dgq?czsF^Ja7;cSqLp+oHASsil+&XjKTq#xe@6vrIuqZ^Qrb9K6! zzHz4XnrIwCQw^%ucn}Yq-BpZz8t!6L)-&8m+DUmFlIqpjc5A#qr|nAHp=!~R1DPIF zveiDTJ~{xQI=w;3Z`pwj?+u-LA!W!(^&y$Hbav%&Y_n%E&vMq__A03o(-~4FPwERD z{W3j9@mUWVp{m^GN!M1X)!#txsaG1E5&pFMf}HSURsw3z$$67TqzC$c2ha+6YDR^H^7*Q3OyewAepEY3Yx zqyxyr*+?Ac^aE!jagNg;P{_$otD4|qK<_;9H$a8g$Im^fn4#0r*N!0OK?$ZR0q$N4 z>6VSUf}t)SXzZZCS-t}|1$g?U+C0u|c{!jf8jY~QEI>YM zUdsIzAmnR-?XM*ZvrH4xTIeI1foX`e+*Mm;j^!Pye`j;eQ}J$R`B`|?WM zAS+O^P9vW$CF?883>#Ul2di-S+sRO3yi9N;$WrVd0Cu+biudtTNFdiD9HksH=t&_uCy=LsoCN+>5>|5^epF%HM4~~rKNwz(nEpOC zIQ5 z+~7#Kt)r7As-{Dodq#G3k|W-Ukl{|YK|;q`Uxm931+H@Zpkk>UxbIJ3A(!*R?YP4w zmZwX7)ZxZl9%1AAGdXr?2@jXiBFxdxqSg9R6hEp}f zw#Pyb+71)OLAcS0d5tMUJX?5_89La3%Q2VQ)J_{HwSjUBecj5>g&dwBHQmy2Dy;eWe77BNCMxvH$IxFHul==iNiaKqd=;fE{ z;2$BzR`R^FH(T0L>#&RRwN1HOIW~U1y6ReEHS;L?`4QKl$ ztFcip!5UjVyZ8)%TO+wUM0f}tZ?fahGcY6jF8%6hhQEhZBsYri5SD#61vqtW1<(bq zR3gPC&$Zh(Q-C?&4I`l0%0tiU#>rM>d;{Cc`Tptvr5)w9K0x5BAe$~%g&-Oz|7zm} zZv00?a36zYVl|SS?MDQP_XU?A9OlP_WdVTAu?D>wj?)oLU2*wq6_kDv7w{8+`i~f- z?OOjK-xShcWef`i%%J2p5wjzmO4pesu{0oOL-9@jSNeeYCJw*7@LP+mh>${1`)w*r zKT*zQR*;NiJjbY01Rg*hW{(tkj3Vt;u$Lmj8vla85a;~>psk1d1J($_?VhU8ACUmh zHB)S(1nVWZMS|<72x+lTFqeovZNCKKBk`x3xu!o^%fSy59Q?5;Lf%`-v3FZIc&DBM z?RzY*=xORb_6Kdr-D18~EJ-V2NWZeUYK2}MTrbnCY{cY=J=;S^#xUPR2 zRBohmxSn=6o=&+tPX7QtU)Lr!ji-m&z%Jczr=VbvF4v*7RR6}c>-%YY{^fsU03X5I zeO`}l1mZwav$QAiCop0~p8DA3rN*9%q*GN-3m-~qwW9)>#Z#2U~p&uBpgiUAOF6~zwhzd zor}eD{=Zj3GmYK{KHuLsp)?+Ug9_39O|A<5kjs6ISxau|x{2VYvRuB;Ye;)df|n(D zUV{A+d`SYB1wNZGhcbaxnZPGlNO-#F0#lA%I6lR@2LJG8B>PVu$q*xH5zK=h2Mj0j zr+f;$SG@CB7X#hjJbaSv%`rc7gFACWi5CpKN-5bmC;ioxayqTiowSkNndwACDH{Z-R z^No+bBEMey^gZ9D=RbSD7J>~mT~M#4wTfOyUd@z>26zGT4v82$4ECr^o6Kc4=t(07 zrUN$HZ<{u&0d3X5bP;`5@Sg9x&7h#KZmH!|siMLzJ3O%L+C%lMMYkKwftu;;HRvH& zb#SaE1E<|=Qu`3hR^76j)HSUZ&~2;jBEZy8)n?RXHBTRS&3_}6tf+B0V3Rl4W@82W=J;5cEpt#t8wuHgBy8XHuH6k<>elI(^D&G96E) zGf=m!CJ3qHxrMimYuPvpbAE0*{yBd)!MSq#_{Lf;S&r*mU**T*MjjVNX;*0xzdiqD zpre`yMzIw+@BJ`xoIO@G>n5M#I&HN1Nx1QN6uLdcD0k4Rqkj5@wFGE&SWT;2 z+L|iP&P+a`4P4HKqE?8Bfm;s~T)N8v>Ol98ln4q<{A4^3pdAx==MTd_4HQd;TJfeL zVR9=OL%FCl%c@d&I zH;qU5!R5%HqA35H+)tlWNuIRwq_)u~9Q8k!d`!WU$|8f^^-oGZ?h^R@$`XE~{&hCU zuOcp^%<{*D6lI3LfCvb#XBY5(W|$1)Ty~-J8x$#-p2puZ3xR3DRD6n{oPF>$gr8?~ zB!$0ZKO$4Om%9*pM$kn6Qz97P?`^!D3zJE_n_C)H>H?MWiVtaN@|@NKhDG4#PfRK) zQr(X~W<$8CT_O{BQ!8nwd2(DZ&U9IdKqNKPL!RY<+*J%CQ&02YDgI=slpn*n{L+o0 zz{Iy?iIKy7$YdWf)Q7C}A-+CD8q!@|8sk&2n5QI%U*|KSm-_g-7+8OiEaT?-3})A7 zuPpZ%;tXQFhyX_Ulh%#&0KaeU{QkCcYg#3iOrSjqjzxp4zD&;CyrSj&t&G((YU_g)(6sNS@HMJr*IMaRl z^tqqYt=*6Mqv-Tz+pq4f@9gfCwo0YDrP5}pQwP(OSx z98FJ>xY7$plc+bWME&V%sXL5w)lYlVlPH;}QJ7Cu)Q=}oUtwk=eG#1;MVZ=sw5GN; zw(eC*L8IGl?jF>-L9?MJpQQciC{q1s5GPTt2GgWBiPI!klT>9<*jFG{4bto+oZuH0 z8N{O~UsGYySCe6saNNrbOR6Zw_e|~kyLJC?H|VtL)x*7JqpQ+P6~77s)dQ|DPU7U4 zXw>oObUeiJS$ZPh^K_c^BE2{ktf(MS38@&VX&$X{Odb^oQZM7tNDadm5vV>1$78VI z9K3O+4wAT+_CaofU$T6v_C+|~%GG|Y)^TqtstTM*^m25ndf)}wnxCE=rK4QM*f@D_ z*cWDz25FMVVeff(45~|e2Mu9%r&P9rR;_CHiMsvNKUCY#{Ps?>yALU7gKHexr*0J4Oy5G>YQQ_}>hmKT`= z+)0|OH-h>ahrS%fy`k!bP=$D+RluNv{zGa74KPE~EQ|7SO65&Sd)(JD?+wE&>`kI9 zuV9yvN-;IVMnE@_>{a)J`r(@T*bg2*>8`0xz1qMp|C3g=(Sa?gN%$PhaO&$M5huWz zKx>7AssZk52908{3S77Yk&HnT>^IbgXIRq-{?4~-qTy*4YiooV=JAhdwY?GO<~%V8 z)e1iG>+3R=0&X>7@cOGG?F>a_?zS)v90p^7I3A}Mnv2vU?OH_EB%drf0>{HF3r}Yo zpfzbeTO%{_B^%8qt%Mg9gp8-|2u?h}&P5+~4ubmbdab$NYIcIIzow3&QTnn1_Z2M| zi_?5fqm!z$Y0J@>fF^k~8kn_vVFK*1jZ>}HD(v;5@gzKgO+jBk5tM8)l>OK0+s&5W zpmz)OW2Xxf-=Dcq7+n=kIigoi6Ywxjrmxg=5|84^sdk#Vvsr9BS3#%w@Zr5jA8oFw zJjE*TxrW=;Lg9%42M}ftn}l*fK*3<92*i}AZ~{}AC-LYM)&O0EZA9_$5Q}w2VS-=OKmXM@)V>6p>yz3O zM4A4~PQ-bc7$a`JTuVoz2qEZ2M9iwzoI&k1_kYXwe_H~xwWSD zU_c03?dBuo(7#3C^g9vQI+E@z;XfuvTHucN6$V5eah*u*%TAX-8tD@Xl- z4#}!)0x(z&r;GJ-j%*>=G^+c)TQ^@tFvU`Cf6$nMzqad8X|zX$K_JRWIFXrvgLm<9 zf`G`W+E;5`W3-%Y+TwC}OcbpsQeeoP5dvyydGLhUDf1V{avA}{6pbhyY@bgqI4Qdp z{)CJBrbenL%dm=QJ+_sF(4MHTU5SW}9?bY(YFC;wv2ijOXK63O-f5}>=xO@WM2p!T zK%XR|nMz5fsnkB61c)ZgTStG)gc5w}?nw_`LUqTXH-BvfeQ2J&*c`*VKBU z-vtL?N}=M2&jTtHMu#J&l^|aSJr@tGK3W~aP{^E=U^z_$K;x5&L(%E&WrLS({HPf42_=fe} zpl$LwohPVmiNM=*M{2v>>{gj?tLFSd0AT zwL|u7b0NvVbDMjctQqb3zTKi$rzzBRmV^r8Zeh(F}5 zD+SW&WIUDB(7F$7@Cc6h)TKF=>g$ z5=iS=|5m8X#j|yO6W6A;Yfq}}^^V`|plYkO)(;v_8_ka!bfm3z@C@drwzYH)8hGFG zcVWlXk1;N&HFy1W!h*)*i(TX*xyCydUYLAH@+;%SBx*96y)$nJb*0OIX)L(I`B;=s zkJkGr$$OKOY0qHh3Xws~>48e7Z0B4~zgghF(IeUamCHne@;Pvs1;e!-78jV&O@lLX9GEVf)aPu*3S1?e#=HZkZ8II&Ucr_OyE(GyhNe27};`~L$1px^pV^UX&B9oQ5)Lt+c=Mmv5R!%0>6ef0&F-} z!}O)isLC^RY&qtuhNI`VLv$*4gxKFtrQAWB&^eSiEyHR!lp&(^2xSY4sQFrdGEAjK zp&d^#p`&n6EWbd_hO#F)cJWJayIyFH&Sjz8f1^0(U7S#K5r4ovvb#)53`ZeDd`pm` zApbcN7BIZHH^j2}wblU8of!0V;pJ7?^qf{*uZO7*lqHm23Azd+Nq*^J3(aZ9MEYvr zx`i;LgVHU<4sybj)r3xy@}OTKsTnsRkzd++rSoE#?8W`$QKH(N})AZPCI?UOChg#uZ| zb)8MBE=u;yy3=Hdl}X?Q12rR;CBx>8kL!o6Cs2FcVsai_oHTP=cn?h$x@7u{0LMve zv}w;_s%Y)^OR7F6dI_o~UDf+DPkmMIe@^Rtqsu(>_yUymXU`&LP0*_o zjH?q2eU^1~f}uNTU+fc%Mzia8N}qn}{rBKg?`9WCroGlP-|H?ULnik|)z#;9gdQ)u zhnv0>%5RH-5(L=~8Hk4lo8{8_d9^^0yazqF3WI<4qrT zVS+W1xzK|-h!usqA#6>^^$sZ$p;h+gkK5LPoQZ|DbuX=BInpxcG&m5$nP)#f#u@#Z zJre~HqqrAO(86Vx+g^%#O`?HnQ;vO896J+T-ophdq{kveyu#m6{2XWMtQ~Rk#@jyV zCG*tWRS98YN`z4=^5+pI`NLwOA7(tA`PlC%i<*0I8L94}wdax%mLLNUo zmMaoyU+Vi5_VQF=Tl%PQ{vgKjOgD$1h3N@$f2qQG2uNDoIS~UkiO>g2!v2|>=Wo(; zRxnHGh(2Y(+4le{kG%_Hc&q~n@`K$L`Bq?(93@bPvAKdV;Ed3(;ZP*-JG3jv!<5x2 zZu3plDa2(8O%b;{+#TVRmnMhnZxNdNkR30SXe-gz)E++3{{{BynB@qcjOH)_5# z$fQZOfnpc`t*UalReh{q;Hl-eO_bqjx2Ri|5R zcX5uwxgV%apdq^Zn_KF^qb(wpnYtg>!qj@R`Lv_TKRBrFs+!-x{X>6uRq-sxyy+Zp zX*t&eqM-3C=ma}B25+Lg@A!3Swp<~T?=2k60)V3(dCO~Tn;X{u?cwJZ34{Y_uU)}KETGivrPjF`!%+%~MU%H1R;-JyM3xY8B z;a&CM?p<|nt2nod+nh2{#EK!0?yI}^?yLJ75H87C#ms75ZhYc!jH6`aZ>9jic_r{m zEb#w>O<#%hGTSiBcvYPFd*1urraYOC>nq+ji{HFK=T>tzOLMB5fZcdc1(wiT`h)T_0pqKg&py~kCISZ?&& zApZmJt!RNz-Ud5VZkY>TIfXJ><_OR@cPMhtE)F2NZYbq;4Vd>PI_39dMEuBk%b-^`gSG0Ba_&(O5t z^xiC{D?f9QnBJ8FFJ(=aN=%oEGw+I+&tEvWR627-%xCRqmQvt%Wlc*tz28b=uEcav zg?OoS=1NRgVruY|U|+n{QnmJ_QsAYCxl~d6QiX$e$eFk4E&b8kwW6+j-j;XsiC=%_ zcZ1qnH{QN1eZSXr_0a2@kY+ox+z$Jf3Bg6?Rm1o zIv$|ip0|ddn|zROX2>;sd;dxMpzc>5``x{Udv6DE#{bVCcHd{2|5lIbcB2bKOP~D73z7X1kK-gaPoxg94B@veJ4qNkrKlq^hC<*3k)gce zho}(OlQBH^vAa@yB-By!XaUl)5SdLP1u>=Cwy)fDw>>uo*_K|yLEz}lEc)0&EL~1$ z4)I^uAr1}MFi*Rah#RwG$2iEJSct>?(E=o}5I1Xg0phgV%IHH5`5Jx%@mK8wHCz}+ zh)9^*m%-$Whz8w0Jx0W96z&56#VpEvAPNyIQG9;^vTq?mF~`VY&JuAGA|^(NmlR>Y5DIaiRE(=$IHhegs+7_hj?*u$1b<6@7Y;S5KhDb;eyVmxG{^XJBXwCyB0I0 zAvDWINv6Z>9FK#zF^+}*V(~1lZuqp~^ppS+pg8AS_z|_gjR#@ehj`!@35vom@V@e^H+EfVbMhhi<+@p?pe{Lavh6mx`pIV4uHTvbaB*G$< zHT(!t2XT7gIMA?T9N(PO9RDweqKRlo%FzPJpRHQ`tEI;pn>Cvib@mMfCkph^z7ZyK zSN~)oB2y|a^+&`fQX|Bvw3`*%F|sD{Y*>h;Mzo3_qD<5a(O^Oxn*XtrL{o@HD3z&3 zy|(QTAp$5?eq|wczq9BsEAV5-jv+Nf{viQZUR7iu%yx1hyS|`aRn);M6L&4oSNV_d zL4pR2YSB4=X88}v5$%)@m@Zucq{xEF^O)YqgLBEwF^MbSBxT2Nrf9odm*I35k6olE z;<*)E3=+>y^^v@avt8tJvn9#mbRm{wKERJ4bY9Fwx7&Q>@DQ`hUKgmC4>X2AJzLTZ zt`}N-qT~E%34Qq+YNgcYR5?NcT>`p8#>pLuS}QXJ#<`5ik(bcpZ&%|c}7#51;# z1uE{_H;%XeVIdq#Msqc9rCgRvL%3|*lq;z{kx Nx4*XXpFjTh{{>7UQ=matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101 + + :EDIT-BY "mth" + + :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH + WRITE-BDF-TO-DISPLAYFONT-FILES) + (FILE-ENVIRONMENTS "READ-BDF") + (IL:VARS IL:READ-BDFCOMS) + + :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| +) + + +(IL:PRETTYCOMPRINT IL:READ-BDFCOMS) + +(IL:RPAQQ IL:READ-BDFCOMS + ((IL:STRUCTURES BDF-FONT GLYPH) + (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) + (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME + GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING + READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) + (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) + IL:SYSEDIT) + (IL:FILES (IL:LOADCOMP) + IL:FONT)) + (FILE-ENVIRONMENTS "READ-BDF") + (IL:PROP (IL:DATABASE) + IL:READ-BDF))) + +(DEFSTRUCT (BDF-FONT (:CONC-NAME "BF-")) + "Main structure to hold a parsed BDF font file" + (NAME NIL :TYPE STRING) + (SIZE NIL :TYPE LIST) + (BOUNDINGBOX NIL :TYPE LIST) + (METRICSSET 0 :TYPE (INTEGER 0 2)) + (PROPERTIES NIL :TYPE LIST) + SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) + (SLUG NIL :TYPE GLYPH)) + +(DEFSTRUCT GLYPH + "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" + (NAME NIL :TYPE STRING) + ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP + (MCODE 0 :TYPE INTEGER) + (WIDTH 0 :TYPE INTEGER) + (ASCENT 0 :TYPE INTEGER) + (DESCENT 0 :TYPE INTEGER)) + +(DEFCONSTANT MAXCHARSET 255) + +(DEFCONSTANT MAXTHINCHAR 255) + +(DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) + +(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") + (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") + (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") + (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") + (LET (GBCS CSGLYPHS CSLIMITS) + (UNLESS (AND (INTEGERP CSET) + (<= 0 CSET MAXCHARSET)) + (ERROR "Invalid Character set: ~S" CSET) + + (IL:* IL:|;;| "Can we get here? I think not!") + + (SETQ CSET 0)) + (SETQ GBCS (COND + ((LISTP FONT) + + (IL:* IL:|;;| + "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET") + + FONT) + ((BDF-FONT-P FONT) + + (IL:* IL:|;;| + "If passed a BDF-FONT, look only at glyphs in the mapped charsets") + + (FIRST (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE))) + (T (ERROR "Invalid FONT: ~S" FONT)))) + (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS))) + (LET ((TOTAL-WIDTH 0) + (ASCENT 0) + (DESCENT 0) + (FIRSTCHAR MOST-POSITIVE-FIXNUM) + (LASTCHAR MOST-NEGATIVE-FIXNUM) + (CSINFO (IL:|create| CHARSETINFO)) + (DLEFT 0) + SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) + (COND + ((GLYPH-P SLUG-OR-WIDTH) + (SETQ SLUG SLUG-OR-WIDTH) + (SETQ SLUGWIDTH (1+ (GLYPH-WIDTH SLUG))) + (SETQ ASCENT (MAX ASCENT (GLYPH-ASCENT SLUG))) + (SETQ DESCENT (MAX DESCENT (GLYPH-DESCENT SLUG)))) + ((INTEGERP SLUG-OR-WIDTH) + (SETQ SLUGWIDTH SLUG-OR-WIDTH)) + (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH))) + (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL)) + (GL (CDR XGL)) + (GWIDTH (GLYPH-WIDTH + GL)) + (ASC (GLYPH-ASCENT GL)) + (DSC (GLYPH-DESCENT + GL))) + + (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLYPH-DESCENT calculated by READ-GLYPH will not give a useful value, since it is >= 0. Investigate correcting this.") + + (IL:* IL:|;;| +  + "Is the above statement actually true?") + + (SETF (GLYPH-MCODE GL) + MCODE) + (SETQ FIRSTCHAR + (MIN FIRSTCHAR MCODE + )) + (SETQ LASTCHAR + (MAX LASTCHAR MCODE) + ) + (INCF TOTAL-WIDTH GWIDTH) + (SETQ ASCENT + (MAX ASCENT ASC)) + (SETQ DESCENT + (MAX DESCENT DSC)) + GL))) + (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT) + (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT) + (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO)) + + (IL:* IL:|;;| + "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)") + + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I + TOTAL-WIDTH)) + (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) + + (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") + + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I + SLUGWIDTH)) + (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) + + (IL:* IL:|;;| "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ") + + (IL:* IL:|;;| " From \\READSTRIKEFONTFILE, so -ve DESCENT is possible?") + + (SETQ HEIGHT (+ ASCENT DESCENT)) + (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH) + HEIGHT 1)) + (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) + (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM + (GLYPH-BITMAP + GL)) + (SETQ GLW (GLYPH-WIDTH GL)) + (SETQ MCODE (GLYPH-MCODE GL)) + (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) + (+ DESCENT (GLYPH-BBYOFF0 GL)) + (BITMAPWIDTH GLBM) + (BITMAPHEIGHT GLBM) + 'INPUT + 'IL:REPLACE) + (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) + (IL:\\FSETOFFSET WIDTHS MCODE GLW) + (INCF DLEFT GLW)) + + (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") + + (IF SLUG + (LET ((GLBM (GLYPH-BITMAP SLUG))) + (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (MAX 0 (GLYPH-BBXOFF0 SLUG))) + (+ DESCENT (GLYPH-BBYOFF0 SLUG)) + (BITMAPWIDTH GLBM) + (BITMAPHEIGHT GLBM) + 'INPUT + 'IL:REPLACE)) + (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH) + 0 + (1- SLUGWIDTH) + (+ ASCENT DESCENT) + 'IL:REPLACE)) + CSINFO)))) + +(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL + MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth") + (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") + (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") + (WHEN (AND (BDF-FONT-P BDFONT) + FAMILY) (IL:* IL:\; "FAMILY Cannot be NIL") + (PROG* ((SLUG (BF-SLUG BDFONT)) + (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) + FONTDESC DEV GBCSL CHARSETS) + (WHEN (FONTP FAMILY) + (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY) + (OR SIZE (FONTPROP FAMILY 'IL:SIZE)) + (OR FACE (FONTPROP FAMILY 'IL:FACE)) + (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) + (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE)) + MAP-UNKNOWN-TO-PRIVATE))) + (WHEN (LISTP FAMILY) + + (IL:* IL:|;;| "Assume this is a FONTSPEC") + + (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC IL:FSFAMILY) + IL:|of| FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) IL:|of| FAMILY) + SIZE) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSFACE) IL:|of| FAMILY) + FACE "MRR") + (OR (IL:|fetch| (IL:FONTSPEC IL:FSROTATION) IL:|of| FAMILY) + ROTATION 0) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) IL:|of| FAMILY) + DEVICE + 'DISPLAY) + MAP-UNKNOWN-TO-PRIVATE))) + (SETQ FAMILY (IL:\\FONTSYMBOL FAMILY)) + (UNLESS (AND (INTEGERP SIZE) + (PLUSP SIZE)) + (ERROR "Invalid SIZE: ~S~%" SIZE)) + (COND + ((NULL ROTATION) + (SETQ ROTATION 0)) + ((NOT (AND (INTEGERP ROTATION) + (>= ROTATION 0))) + (IL:\\ILLEGAL.ARG ROTATION))) + (SETQ DEV DEVICE) + (SETQ DEV (COND + ((NULL DEVICE) + 'DISPLAY) + ((AND (SYMBOLP DEVICE) + (NOT (EQ DEVICE T))) + + (IL:* IL:|;;| + "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.") + + DEVICE) + ((STRINGP DEVICE) + (INTERN (STRING-UPCASE DEVICE) + "IL")) + (T (IL:\\ILLEGAL.ARG DEVICE)))) + (SETQ FACE (IL:\\FONTFACE FACE NIL DEV)) + (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) + (UNLESS SLUGWIDTH + + (IL:* IL:|;;| + "If GLYPHS-BY-CHARSET didn't determine the SLUG width, use 60% of the SIZE, at least 1") + + (SETQ SLUGWIDTH (OR (THIRD GBCSL) + (MAX 1 (ROUND (* 0.6 SIZE)))))) + (FLET ((GBCS-TO-FONTDESC + (GBCS FAMILY) + (LET (FONTDESC CHARSETS) + (WHEN GBCS + (SETQ FONTDESC + (IL:|create| FONTDESCRIPTOR + IL:FONTDEVICE IL:_ DEV + IL:FONTFAMILY IL:_ FAMILY + IL:FONTSIZE IL:_ SIZE + IL:FONTFACE IL:_ FACE + IL:|\\SFAscent| IL:_ 0 + IL:|\\SFDescent| IL:_ 0 + IL:|\\SFHeight| IL:_ 0 + IL:ROTATION IL:_ ROTATION + IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION + DEV))) + (SETQ CHARSETS (LOOP :FOR CS :IN GBCS :WITH CSET :WITH CSINFO :NCONC + (WHEN (<= 0 (SETQ CSET (FIRST CS)) + MAXCHARSET) + (SETQ CSINFO (BDF-TO-CHARSETINFO + GBCS CSET (OR SLUG (1+ + SLUGWIDTH + )))) + (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET + ) + (LIST CSET))))) + (LIST FONTDESC CHARSETS)))) + (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) + FAMILY) + (GBCS-TO-FONTDESC (SECOND GBCSL) + (IL:\\FONTSYMBOL (CONCATENATE 'STRING + (SYMBOL-NAME FAMILY) + "-UNMAPPED"))) + (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) + :TEST + #'EQL))))))))) + +(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") + (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth") + (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") + (UNLESS (TYPEP BDFONT 'BDF-FONT) + (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) + (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME + PIXEL-SIZE POINT-SIZE) + (SPLIT-FONT-NAME (BF-NAME BDFONT)) (IL:* IL:\; "Parse as XLFD format") + (DECLARE (IGNORE FOUNDRY ADD_STYLE_NAME)) (IL:* IL:\; + "Don't need FOUNDRY or ADD_STYLE_NAME") + (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) + (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) + '((#\R . MEDIUM) + (#\M . MEDIUM) + (#\N . MEDIUM) + (#\B . BOLD) + (#\D . BOLD) + (#\L . LIGHT))))) + 'MEDIUM)) (IL:* IL:\; "DemiBold => BOLD") + (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) + '((REGULAR) + (#\R . REGULAR) + (#\I . ITALIC) + (#\O . ITALIC))))) + 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") + (IL:* IL:\; "Ignore others") + (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) + '((#\R . REGULAR) + (#\N . REGULAR) + (#\B . BOLD) + (#\S . COMPRESSED) + (#\C . COMPRESSED))))) + 'REGULAR)) (IL:* IL:\; + "S is for \"SemiCondensed\", Assuming \"Condensed\"") + + (IL:* IL:|;;| + "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") + + (WHEN (AND (EQ WEIGHT EXPANSION) + (EQ EXPANSION 'BOLD)) + (SETQ EXPANSION 'REGULAR)) + (WHEN (ZEROP (LENGTH PIXEL-SIZE)) + (SETQ PIXEL-SIZE NIL)) + (SETQ POINT-SIZE (COND + ((ZEROP (LENGTH POINT-SIZE)) + NIL) + ((SETQ POINT-SIZE (PARSE-INTEGER POINT-SIZE :JUNK-ALLOWED T)) + (CEILING POINT-SIZE 10)) + (T NIL))) + (LIST FAMILY (LIST WEIGHT SLANT EXPANSION) + (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) + POINT-SIZE + (FIRST (BF-SIZE BDFONT)))))) + +(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") + (IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth") + (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") + (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") + (LET* ((NCSETS (+ MAXCHARSET 2)) + (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) + (UTOMFN (COND + (RAW-UNICODE-MAPPING #'IDENTITY) + (MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE) + (T #'UTOMCODE?))) + (SLUG (BF-SLUG FONT)) + (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) + NOMAPPINGCSETS ENC MCODE MCS) + (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT + (CONS NIL))))) + (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY) + (TCONC (AREF CSARRAY (LRSH CODE 8)) + (CONS (LOGAND CODE 255) + GLYPH)))) + (LOOP :FOR GL :IN (BF-GLYPHS FONT) + :UNLESS + (EQ GL SLUG) + :DO + (SETQ MCS NIL) + (SETQ ENC (GLYPH-ENCODING GL)) + (WHEN (LISTP ENC) + + (IL:* IL:|;;| + "Should happen only if -1 is first on ENCODING line in BDF file") + + (SETQ ENC (OR (SECOND ENC) + -1)) + + (IL:* IL:|;;| + "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it") + + ) + (SETQ MCODE (AND (INTEGERP ENC) + (PLUSP ENC) + (FUNCALL UTOMFN ENC))) + (IF RAW-UNICODE-MAPPING + (COND + ((> ENC 65535) + (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC) + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + ((AND NIL (= 255 (LOGAND ENC 255))) + + (IL:* IL:|;;| + "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode") + + (WARN + "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR" + (LRSH ENC 8) + (LRSH ENC 8)) + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) + (COND + ((AND (ZEROP (GLYPH-BBW GL)) + (ZEROP (FIRST (GLYPH-DWIDTH GL)))) + + (IL:* IL:|;;| + "This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET") + + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + ((NULL MCODE) + + (IL:* IL:|;;| "These assoc with the Unicode encoding") + + (COND + ((OR (> ENC 65535) + (= 255 (LOGAND ENC 255))) + + (IL:* IL:|;;| + "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET") + + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) + ((AND (INTEGERP MCODE) + (<= 0 MCODE 65535)) + + (IL:* IL:|;;| + "These assoc with the 8 bit character code within the charset") + + (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) + + (IL:* IL:|;;| "Default SLUG width is width of A.") + + (WHEN (AND (NOT SLUGWIDTH) + (= ENC (CHAR-CODE #\A))) + + (IL:* IL:|;;| "A is the same code in MCCS and UNICODE ") + + (IL:* IL:|;;| + "Comparing with ENC, not MCODE, to look only in charset 0") + + (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) + ((LISTP MCODE) + + (IL:* IL:|;;| + "These assoc with the 8 bit character code within the charset (like above)") + + (LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS + (LRSH MC 8)) + MCS) + :DO + (PUSH CS MCS) + (PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS))) + (T (ERROR "Invalid MCODE: ~A~%")))))) + + (IL:* IL:|;;| "Extract the lists from the TCONC pointers") + + (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I) + (SORT (REMOVE-DUPLICATES + (CAR (AREF CSETS I)) + :TEST + #'EQUAL) + #'< :KEY #'CAR))) + (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC + (LET ((CS (AREF CSETS I))) + (WHEN CS + (LIST (LIST I CS)))))) + + (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.") + + (WHEN NOMAPPINGCSETS + (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO + (SETF (AREF NOMAPPINGCSETS I) + (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I)) + :TEST + #'EQUAL) + #'< :KEY #'CAR))) + (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC + (LET ((CS (AREF NOMAPPINGCSETS I))) + (WHEN CS + (LIST (LIST I CS))))))) + (LIST CSETS NOMAPPINGCSETS SLUGWIDTH))) + +(DEFMACRO PACKFILENAME.STRING (&WHOLE WHOLE) (IL:* IL:\; "Edited 1-Feb-2025 23:17 by mth") + `(IL:PACKFILENAME.STRING ,@(LOOP :FOR X :IN (CDR WHOLE) + :BY + #'CDDR :AS Y :IN (CDDR WHOLE) + :BY + #'CDDR :NCONC (LIST (COND + ((KEYWORDP X) + (LIST 'QUOTE (INTERN (STRING X) + "IL"))) + ((AND (LISTP X) + (EQ (FIRST X) + 'QUOTE) + (SYMBOLP (CADR X))) + (LIST 'QUOTE (INTERN (STRING (CADR X)) + "IL"))) + (T + (IL:* IL:\; "Hope for the best!") + X)) + Y)))) + +(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") + (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") + (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") + (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") + (LET + (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL (NGLYPHS 0) + (*PACKAGE* (FIND-PACKAGE "BDF"))) + (WITH-OPEN-FILE + (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT) + (LOOP :WHILE (STRING-EQUAL "COMMENT" (SETQ KEY (READ FILE-STREAM))) + :DO + + (IL:* IL:|;;| "Ignore initial COMMENT lines.") + + (READ-LINE FILE-STREAM)) + (UNLESS (STRING-EQUAL "STARTFONT" KEY) + (ERROR "Invalid BDF file - must begin with STARTFONT.")) + + (IL:* IL:|;;| "ignore the file format version number") + + (READ-LINE FILE-STREAM) + (SETQ FONT (MAKE-BDF-FONT)) + (LOOP + :UNTIL FONT-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) + (WHEN LINE (IL:* IL:\; "Ignore blank lines") + (MULTIPLE-VALUE-SETQ (KEY POS) + (READ-FROM-STRING LINE)) + (UNLESS (MEMBER KEY '(COMMENT CONTENTVERSION)) + (WHEN (<= POS (LENGTH LINE)) + (SETQ LINE (SUBSEQ LINE POS))) + (COND + ((EQ KEY 'FONT) + (SETF (BF-NAME FONT) + LINE)) + (T + (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) + (CASE KEY + (METRICSSET (IF (AND (INTEGERP (SETQ V (FIRST ITEMS))) + (<= 0 V 2)) + (SETF (BF-METRICSSET FONT) + V) + (ERROR + "Invalid BDF file - METRICSSET (~A) is invalid or out of range." + V))) + (SIZE (SETF (BF-SIZE FONT) + ITEMS)) + (FONTBOUNDINGBOX (SETF (BF-BOUNDINGBOX FONT) + ITEMS)) + (SWIDTH (SETF (BF-SWIDTH FONT) + ITEMS)) + (DWIDTH (SETF (BF-DWIDTH FONT) + ITEMS)) + (SWIDTH1 (SETF (BF-SWIDTH1 FONT) + ITEMS)) + (DWIDTH1 (SETF (BF-DWIDTH1 FONT) + ITEMS)) + (VVECTOR (SETF (BF-VVECTOR FONT) + ITEMS)) + (STARTPROPERTIES + (IF (AND (INTEGERP (SETQ V (FIRST ITEMS))) + (PLUSP V)) + (SETQ PROPS + (LOOP :UNTIL PROPS-COMPLETE :APPEND + (WITH-INPUT-FROM-STRING + (SI (SETQ LINE (READ-LINE FILE-STREAM))) + + (IL:* IL:|;;| "As of now, COMMENTS not allowed here.") + + (UNLESS (SETQ PROPS-COMPLETE + (STRING-EQUAL "ENDPROPERTIES" + (STRING-TRIM '(#\Space #\Tab) + LINE))) + (SETQ KEY (READ SI)) + (IF (AND KEY (SYMBOLP KEY) + (SETQ VV (READ SI)) + (OR (STRINGP VV) + (INTEGERP VV))) + (LIST (INTERN (STRING KEY) + "KEYWORD") + VV) + (ERROR + "Invalid BDF file - malformed PROPERTY (~A)." + LINE)))))) + (ERROR + "Invalid BDF file - STARTPROPERTIES count (~A) is invalid or missing." + V)) + (IF (EQL V (SETQ VV (/ (LENGTH PROPS) + 2))) + (SETF (BF-PROPERTIES FONT) + PROPS) + (ERROR + "Invalid BDF file - STARTPROPERTIES count (~D) does not match actual (~D)." + V VV))) + (CHARS + (SETQ NGLYPHS (FIRST ITEMS)) + (UNLESS (AND NGLYPHS (INTEGERP NGLYPHS) + (PLUSP NGLYPHS)) + (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." + NGLYPHS)) + (SETF (BF-GLYPHS FONT) + (LOOP :REPEAT NGLYPHS :COLLECT + (PROG1 (SETQ GL (READ-GLYPH FILE-STREAM FONT)) + + (IL:* IL:|;;| + "Any GLYPH with ENCODING of -1 is taken as the SLUG glyph. If multiple, the last applies.") + + (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + (WHEN (EQ V -1) + (SETF (BF-SLUG FONT) + GL)))))) + (ENDFONT (SETQ FONT-COMPLETE T)))))))) + (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) + SIZE) + (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* + "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" + (BF-NAME FONT) + FAMILY SIZE WEIGHT SLANT EXPANSION)) + (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE))))) + +(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) + (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") + (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT))) + (READ-DELIMITED-LIST DELIMIT SI))) + +(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") + (IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth") + (IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth") + (IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth") + (IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth") + (LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT)) + :DWIDTH + (COPY-LIST (BF-DWIDTH FONT)) + :SWIDTH1 + (COPY-LIST (BF-SWIDTH1 FONT)) + :DWIDTH1 + (COPY-LIST (BF-DWIDTH1 FONT)) + :VVECTOR + (COPY-LIST (BF-VVECTOR FONT)))) + CHAR-COMPLETE LINE ITEMS V KEY POS STARTED BBW BBH) + (LOOP :UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) + (WHEN LINE (IL:* IL:\; "Ignore blank lines") + (MULTIPLE-VALUE-SETQ (KEY POS) + (READ-FROM-STRING LINE)) + (WHEN (<= POS (LENGTH LINE)) + (SETQ LINE (SUBSEQ LINE POS))) + (COND + ((EQ KEY 'COMMENT) (IL:* IL:\; "Ignore COMMENT lines") + (IL:* IL:\; + "Probably aren't \"legal\" here, anyway.") + ) + ((EQ KEY 'STARTCHAR) + (WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph.")) + (SETF STARTED T) + (SETF (GLYPH-NAME GLYPH) + (STRING LINE))) + (T (UNLESS STARTED (ERROR + "Invalid BDF file - glyph has not been started. STARTCHAR missing." + )) + (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) + (CASE KEY + (ENCODING (SETF (GLYPH-ENCODING GLYPH) + (IF (EQUAL -1 (FIRST ITEMS)) + ITEMS + (FIRST ITEMS)))) + (SWIDTH (SETF (GLYPH-SWIDTH GLYPH) + ITEMS)) + (DWIDTH (SETF (GLYPH-DWIDTH GLYPH) + ITEMS)) + (SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH) + ITEMS)) + (DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH) + ITEMS)) + (VVECTOR (SETF (GLYPH-VVECTOR GLYPH) + ITEMS)) + (BBX (SETF (GLYPH-BBW GLYPH) + (SETQ BBW (FIRST ITEMS)) + (GLYPH-BBH GLYPH) + (SETQ BBH (SECOND ITEMS)) + (GLYPH-BBXOFF0 GLYPH) + (THIRD ITEMS) + (GLYPH-BBYOFF0 GLYPH) + (FOURTH ITEMS))) + (BITMAP (LET* ((BM (BITMAPCREATE BBW BBH 1)) + (BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM)) + (BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH + IL:|of| BM)) + (NBYTES (CEILING BBW 8)) + (NCHARS (* 2 NBYTES)) + (NWORDS (CEILING BBW 16)) + BITS BYTEPOS WORDINDEX) + (LOOP :WITH BITROW = 0 :REPEAT BBH :DO + (SETQ LINE (STRING-TRIM '(#\Space #\Tab) + (READ-LINE FILE-STREAM))) + (UNLESS (AND (EQUAL NCHARS (LENGTH LINE)) + (SETQ BITS + (PARSE-INTEGER LINE :RADIX 16 + :JUNK-ALLOWED T))) + (ERROR + "Invalid BDF file - bad line in BITMAP: ~A" + LINE)) + (WHEN (ODDP NBYTES) + (SETQ BITS (ASH BITS 8))) + (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) + (SETQ BYTEPOS (* 16 (1- NWORDS))) + (LOOP :REPEAT NWORDS :DO + (IL:\\PUTBASE BM.BASE WORDINDEX + (LDB (BYTE 16 BYTEPOS) + BITS)) + (INCF WORDINDEX) + (DECF BYTEPOS 16)) + (INCF BITROW)) + (SETF (GLYPH-BITMAP GLYPH) + BM))) + (ENDCHAR (SETQ CHAR-COMPLETE T))))))) + (SETF (GLYPH-ASCENT GLYPH) + (+ (GLYPH-BBH GLYPH) + (GLYPH-BBYOFF0 GLYPH))) + (SETF (GLYPH-DESCENT GLYPH) + (ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH)))) + (SETF (GLYPH-WIDTH GLYPH) + (MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH)) + (GLYPH-BBW GLYPH)) + (FIRST (GLYPH-DWIDTH GLYPH)))) + GLYPH)) + +(DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth") + (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") + + (IL:* IL:|;;| "First, check if it COULD be in XLFD format") + + (COND + ((POSITION #\- NAME :TEST #'CHAR=) + (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) + 1 + 0) + THEN + (1+ J) + :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=) + :COLLECT + (SUBSEQ NAME I J) + :WHILE J)) + (T + (IL:* IL:|;;| "Return the NAME as FAMILY with a NIL FOUNDRY") + + (LIST NIL NAME)))) + +(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE + (CHAR-SETS T) + MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED + RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth") + (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") + (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") + (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") + (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") + (UNLESS (TYPEP BDFONT 'BDF-FONT) + (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) + (COND + ((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets") + ) + ((NULL CHAR-SETS) + (SETQ CHAR-SETS '(0)) (IL:* IL:\; "Only charset 0") + ) + ((AND (INTEGERP CHAR-SETS) + (<= 0 CHAR-SETS MAXCHARSET)) (IL:* IL:\; "A single integer charset") + (SETQ CHAR-SETS (LIST CHAR-SETS))) + ((AND (LISTP CHAR-SETS) + (EVERY #'(LAMBDA (CS) + (AND (INTEGERP CS) + (<= 0 CS MAXCHARSET))) + CHAR-SETS))) + (T (ERROR "Invalid specification of :CHAR-SETS ~S~%" CHAR-SETS))) + (DESTRUCTURING-BIND (FN-FAMILY FN-FACE FN-SIZE) + (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) + (SETQ FAMILY (OR FAMILY FN-FAMILY)) + (WHEN RAW-UNICODE-MAPPING + (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) + (SETQ FACE (OR FACE FN-FACE)) + (SETQ SIZE (OR SIZE FN-SIZE)) + (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE + MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (UNLESS (EQ CHAR-SETS T) + (SETQ CSETS (INTERSECTION CHAR-SETS CSETS)) + (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) + (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS + (PACKFILENAME.STRING :BODY DEST-DIR :NAME + (IL:\\FONTFILENAME FAMILY SIZE FACE + "DISPLAYFONT" CS)))) + (IF WRITE-UNMAPPED + (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE + UNMAPPED-FONTDESC CS + (PACKFILENAME.STRING + :BODY DEST-DIR :NAME + (IL:\\FONTFILENAME (FONTPROP + UNMAPPED-FONTDESC + 'IL:FAMILY) + SIZE FACE "DISPLAYFONT" CS)))) + (SETQ UNICODE-CSETS NIL)) + + (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") + + (IL:* IL:|;;| + "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)") + + (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) +(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY + +(IL:FILESLOAD (IL:SYSLOAD) + IL:SYSEDIT) + + +(IL:FILESLOAD (IL:LOADCOMP) + IL:FONT) +) + +(DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") + (:EXPORT "READ-BDF" + "WRITE-BDF-TO-DISPLAYFONT-FILES") + (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" + "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" + "BLTSHADE" "BOLD" "COMPRESSED" + "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" + "FONTP" "FONTPROP" "INPUT" "ITALIC" + "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" + "UTOMCODE" "UTOMCODE?" + "WRITESTRIKEFONTFILE")) + :READTABLE "XCL" + :COMPILER :COMPILE-FILE) + +(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) +(IL:DECLARE\: IL:DONTCOPY + (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR +10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 ( +GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 ( +READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 ( +READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827))))) +IL:STOP diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL b/obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL new file mode 100644 index 0000000000000000000000000000000000000000..927778eaf9838aafa5ba0d1b7cc9d57d42e6156d GIT binary patch literal 21485 zcmd^ndwko~mFMsGll+M72*pv1V~kOq;08A`36Bs`3i?@+BUz81k>n(%0iz@?lC3zI zIH9Evuz|D%M8FOK{UB**r?2VE?AY$mCXN$L+v&qlraVH+%xt%v?Y2z2(`jb2Tc)Mp z{ho90Pm)8@=V$-gJao@J=iK+b=bn4+xxaCxdW$dO_U+oaJChyQTmKT{{PE+?m?D_r}oh-hn;Y%*gH=cMj~x4%~Gk!TUxA z_Ke&Z59oeRr@yP?-D|I|NtETWea}E@@4ybXdz~k?>rT&AYp%N1ebv<))~?xb?b@0y zJrNN_S!~JlzC9y5Qg^L(uXBTcVCObej}omerJ6sIe_UI!OTnKzia)gkEm@*6dJ#pO zil*id;^?fIN@t$XjT-Ja~goda3w zh@Bd;$UmB^?&^*Ck|86OKd6psmm))_KhPD51w525l6M(SBq_*Bf0C9|4K4)hlqbmbjdW?87pR2ZpAfId591kS}G#s9!;qfD*h~C#_#FAX+ zME>A%UMog}fzZYvsI`K+Ipj|U^SPSN z2-=hg>V8zO8p$PS?=&KQkkOo;cp#AoAX4iK>hVM%NxhcORmqy=F-EAIKalXnLp@0& zp3hYf0?n`HFm3>>;E_TlLrFan@&OSM)v-t73Dl!98t{jD(UhuqU}JAYr(BXgBL>du z-lP%r8C1bV7I;%Wx0Jgnk&K7J0V;kLkoyXChazG1Au)G;hiuv{R0o z^mvHcM(j0FeTy6s&?j=Wh$n-g7~vSkHUO>*Y|C zyY7z^`n)9kyd*MZ%YhLb=bvmNBNkWCGANW55JS9xoJu}d54kAjwcDD|rDbEg(Y*c& z^uZ;U7pJ~QcD;w1ne6Kc(DbiF$0h^OItXVMM2@G2B#)m)U#yqP>p@vY+#ZNf>;@&$ zHIM>}%P4{Pm8N$E?Hk3^9;34xqP^bqs;1Z0oIhAcqvlm;7<-IREE$M1LNo8=&@RJD z>U)eOL};RlDb(t2 zAi?p<1n&j{_Ltx)fnUpnDnXEuO`FhvhLAIrVyQEiJrU`p1^ozCjU3L=QIcj|9!y>H zUd)6Cs0P-|@bobAa?BaMHvk=b=w$- zE83{}VX7h$Ea+s(f1sG{M>N8d8W9j4frH*BemoPKw6ZfTNGABxy+4RZ# zQnQ(p7N%nG)L8126{}76I|}K3XW?Th02u&flzLEHM5zbGRZeLDrI9ENpfr|Knm}nL zN)sr}<&+js+(c;s#a&Km1!W~sT0vP^PH6*W6;awiSyfJH2W2%;+Cf=exSdAhvi^=j z=#bG7bSZ@}!fuyVh$4)*>;Vn}SsNPjmFd7MJaMcxzW`der zj)LJPsKwzpZz@ zzP*%#=Y&Lm)|$kJ#Uxhl^&S&Ta(uEW!&5HEziFX5Y*Px8Ke!#`DVJ^W&M6qrpm$Eg za3Zi{G=tt}E30Tc5wFHzBB;SgBB;YKB5+^~5jZh`2H<+v zRIt@1?BW;sf&pLH!rwtENs`kCRjwT@fmYE|nc!Dm!|m#7h-Nmnx1fRUBQaIJ#7EbgAO#QpM4s z;&A?rGHjAzvkY5U1w!iI{+HAs?zNAbI&Dy_260PilXEiZK@h3~F&q;4IKj9_`1eu% z9p~Q({yhj@TW9BHq-KB)SF~MqZZW#L)>x6gVuX&>I7Ts{g3qA>EU8JAdcub>7fI=; z#1Ss+2~vKBK<-w=Rd8D z{3qaW2#!*xSedc1L5ux0aMcN}^XeSL^RFeI3#uMJ1<&I0e9otR{H(-uVFl!WmYCkA zgZ#>B+`oZoktj}#qU@w!TMR!hXW*l==*2fIhJP;=QyO)d%Wo{EUz9Uhvq3VwX)&Dv zlkCFcERj5K31#FnV$A*njJ2ZD))bO_^9%U?SBcM>UxE*UjOT#N?`)~y;^dQz>H^09 z4MsUQ#hHmI*_TXbM%?(98g^%fcVzC&?AVvevKn?r_O9LO4tHpHdv@QBff1M#cMiDk zOl9{0-k!>C-2gAS zsVDWt3H7DEoZ=4rJUjhrIjddP+H3=D?w=^ z%1Th$$|lKR#{P&27-tpvGA zeQP6VC8=-i1g#?Vt%IP|q`s{;*0>rexXRT;!8NXC3f8$=5J(;2^-CA3c4F?#@eFzv zN>*uKp~?0g#=pS7FY@n8{QELEX;%?J5P`L$2#_TRK)IU$5_<^&ywZs#mNK9!xmJ}W zC{rDv#csE;_$VoMYJv(@H_(sH;PnJv$>4edFJd_gFJ-(f{iUAs^bR4b(-c=%6M1m`L-FQC=^acZD< zt`XypfI_`X*C3Tr$j-CbSy-Uu4M;xM0Obx=aJuhEx=Z$6N+EPS ztqD42H4YW9UWTGoB<)ELwbJyMwc16dU&X&=be@KqWRc9>rvLY?#>MAU!!k3M*MoXY z-B`sz5QPR*{G&n{6EXu_m@vD`HV>=H`5N6^UfQ`f?6M*+Sy-gg>{9U$)^)4ME}X4H zVkX+2rQ@`IwR=1>njTM&W^S42o^%cBXUEeY)3fskMlZ~*;0LMOJ4?0nYt>d>qIoyVPt*fk6XM4<+u2*g4LNI)ksIC0cfh`~`91QYE! zbfl*ph7RzwpU`o=ldU7u;m-d0N~*wI)6i+Kg|U|y64Q(w#Aq?xXD5u7F~fZ#LUBoJ zAwIX!0-AfwXqlb7q*HX`W1Yz5A#Pcx=&*FUslNqDL)eVy&~LPIizcR&`;1nV5N>0o ziv7q~sr9dtmBA)tNVpkWj|I123z9HS<&A}?(e~!q@#vV*b~0wPogI$>I@N8opYC5X z6E;?#9S@Hgt4~CXjW3Ae9~n!8Z9q$KaU=6L5H;zCSQ}O<`nd5IqNc`8LWn@jQ1y!7aNwn5RRP2 zSach%(?-(}8_F?67DEFhTnO2d{e(J=wshLOjTWo(Oru5ZcZ=?7;9j)4t`$8h;70D% z!9k+|(?a6vvBwV@tIm!Ojv1>?M=UgIv68cv0dMR4vserx8s7GT;iT3y6VytO(`Y^2 zzltVji-y`x&2Ka6r<2wsY3O%T+1*yW9xQ{HGgNd7ik5Q;MY~1OB6wTTlPy>l$Y<#E zpy3*N1sx|URz(vRUFJ+<+YT*P6uY#!+E^}aC9r|PTM4{~!P@|8e@oV*K+NAm5z1k~jV+Ms`0ypQx+(O#!Af5^)YX2^Re-gnzh~TRtc#P^2`j;X&DuRO|xJCqxBB+qXsdax?jx{)R`ph@Nunw6aemYc!h8alx~-u|B(PDBbm;MognR#KJd3t+%xELqw zeqgHvmgK7XUat0s2wcZtia<8Ns&^7-H@guipBBLp6kPOIA^ZVObkB!GkQPC&2sVOQ zIJwk=m!5D#gkmTS{^Z_c+8n!zT;i24401Ykq49LM=W9pZg z-X*5D0_n6mxWQoDXv6}3Ak^>Of75dFNrEQW6NsP=T*F(Ei*h63bob?;D6ir&HX4ts z2bf{dWS=c{G7NQO0%!wzjLazaNUEH|uUjw0(0XGkslbK^XN@={5Ut(U`BYGl95n2RGw}$9I7m1YZOhkLx z3{h}|XH5TxIoPJwAjLAf%_>*8Sn)>#x`PT`DQ4E=`3_%vp4^G~*vmUWb}0Gm+`* zvQ?2m9xmR$UWS^RO&Lu*5KY++vT#3SG-chdj2TTYa#ojU=Sfe5eQ3u0M)pG2u0{7grt+Ym*)lxh;2wy3E!)Y$skdZ zOgRit`4uR(K!hjhG^3B~6v6G3CLV|yn*#3zc##zAmSbhJd9#BVQx{Q|Uo^cGE-|;e?l5W_sZRK#NjsC9ki?v;%RG8-cMB*va6h2%CVD zUYQRhFunyCD*T_xIZrsZsGmG1*AVI@T^^CvD8?w=J>fSks9q<%w9SnK7Zf z2VyAKvH%$_?x^v}od!wtAN4mHj!VZUm*ar%Xrk_FSWpZEKK1)^+%`^Gn7o?%q`zUp zX!vM$KAN5X@%+(qn)5JvBvR@Tj2gyi>aDGVG*tEIKMZgp2plX`xSKcXza-{iX&Uj2 zD@7S9MR~93cVW|R_%iZcVvK|G2u5KeW2D!AMx{50S+7(D)7xZctUAVEyx z@WD*t98Xzl$GKvEN8sNwNDP`VUN9(36JH_h<0Xa!M7wYWCxW=%U{(JAFi$_Q>irCU zl|a5wR~cMGZP={G>Cm8jyU49P1H5n}(BpBvkEl-*D_O=3W;-gx>``%WIC=#m|DG=e z)UP)nf$cUVu=#Y_l5FGzWP>jd!3OZ^4Fq`sRRnJC)#;>TdpBqCS%BK#F!&7uzrf%( z34EHtZxJ}o;2eQD1}T|3Cu|(TKBI0GHjbZ&V3v1XDoeO+cqr&m7VyShA;9G0#DLS7bRFJN?yRCOP zvwhc&0r$W#0=fsrh4Qw6yLJulaIanG-j>-rf)v+ofvt`j@B-y|JM_~fo!%dP$qPxM z3!zF1b`w15h4TZn8Ovkb!{dYD5!Y7-Sj)Cynv2%};;sfy27C!-l!v>oB0;G@F=*c_ zBA}sAWy%m@qy64tXiiN7AK0B5-T`mp^Es*Wxk!1A1rzU~UJVX;UQNSx*DZG>vsNZLmDZwgCsV&q;Ac61TKvi*41Sov z{RApUx&_87Vpr27#2VUc#Qi-hnbd!=2<#uBm2`8jkql%Q^Mef{pd;-0-V@N|RUYKC zFiazO8^bqGZQOVKBX;&uoI8^DAexGF{lq=sKF>5j&eqMF+q|A0Q!FKaP#93S%jCNX zI~hubA{6gC40=a0o>$mVaEOnjdDvp^lR_838r^ zwexQ!{}zpdpw=-4KAwP~8{rpMK=_3UfM1+b@GDPnJPDSls<+hc5+r=gzzn}m{5BV; z4%{s+CFs(I7z}#&Q5G!f?bI`P2-R-Jw9@3EmD!^wgFHIefT}hH;+;k!pzSj&H>1gQ zczEUKwS}biT@Y5n`aEb>4}e_K^KS>KE)WTjCms9e*{EM06a8afB`P!5#4RENYF&Xx z^wH4=gA!Yq{I8O$j!9qO7$<-gQlu@A91dZvu&Q3vcXzeWAUDajj|qbE}3%zC-?Q4>7_74u%ZkWjPR89GbwGC1etS^)Qx^2W_sjcY8> zuFy9TnrsfvHHt|<7}(`uIB#5NIByh#ZA}K*4UMxAK3)xXqX$4MR;{6MGC0>DPHdW( zWt8=8<1tJY2X8@708n?%!v=B`kfwr$qZ3a^#6dV>6^5K3YNBm3k)c;+Cm#uEn8=S5 zn{DATQ*8)QF;)iS5x@)ULyqkb{3S};|2 zbKG#PR4X}Kl6bh5^*Rb1bt<-6NR=g}$D-nCXFK+JXM1mKGYcaaVDXTp-P~QP!q5US zqY5np#uoT-C-L&ovv%#(*ENG;Z$);scpBClNbrL+!YzfMui6^jL~lzFx6Om6l6Fp= zqq8R6&_VknleD}IB;{3mmdj$0bWiQ_D+y~dmJBl5!zG4&46+VA2;N2PC@Kro{J=D_ zPpq_v^FvE|M-$Mal+ij$!Y}1u5()sL3U!vsR$ej<3jP8-m5JWYMBrwM^2-YKuqgM9 z-5@$S1AgHrin)#Iq$wc^lm~nwCidmjl}NBOfd{I1EgwC8 z!5XaXFEBV&xEUpLC%doPa)Qv!imnZIa4Pq^U}NJB-Y-#niqYz?fW8Q()i^)Ov>rHt zLH$?3@O`c>^`!c3f%yt!CI~YrFnl0U#tHM7z&yY_j}qns0>h>;S8`E>uD_v8<=%CkuHTu;((`#d$&wFM`gl^%Xenb*>7zz1)kjx!b>9J=8 zU8n?9J1K{HC+rUj<*2?RpTqYH#ASWi+$}x1JKxmBcM;sX-sj$v8opzI8;~Q_8v+If zT~aOCVc#Lo$(Pz{_Ps-UU~tBUTc!Q)+~FC2l3)_yNa>PafeBHH7N?- z%hTf@KKk$hOItz5qZ;dmZ|%Cnrhx)RNGUot0K4Y^bjbXWR96ZEL;pB<=JQ!Cg_)@o z9uO0jK(39~n!r54*&f#?l_>B-iQ@Tup)-SNXbW9zaZso$Zc}tmK|@Rj2KnII9%0P9 zpM&>{HxftcF?0@`srZ47hdpA<-Qu!9Ibt6|!3!kH7#K@R&o_S8`wBI>m*X47n`<(}F)wVMK3SRr# z%EM+4azzd{VP@Bbl2*g*;lYrYy0>8*Z^Hfv*dIK!wPlgR0J%aU-zOpngE4KT^{^V>5S(^PtaW;ZsxU8gk{7 zet#}zg9jnquQL2Cay-PXwb0J#0#!4bzDw7Dj;xdCa?v?ZcvTLPtDh6Tea0$i_b@a4 zJ@>O1GfpsLG>h*1HXD}O4;t;0&Eg6-E3P&(;>6$YCWfateK#k?)n?PskI#J0aA&Ju zBL~Vhqw%}&Im|lY1^LQ%;hSi*kjG{_A1v0v$iDIg&{{dM;pTwc1y{nnzM6a$TeHqr z03lsFu65eU;@$>YJ2hezFstB7c)jR6IQ%yh9+3Suo;g1C=3YS%zjIC*x=xcHH+Pmd>NM9?Mzw+LJ! zz{4C$CtUY5(%?z|r;A&m+W(yC+7>S3X{s6B=T^jZe`pJ0>W{F?$ww6w#9)g z-z0F7Gg1Fs1cyX`_k={Fr}cQbfiERcY>z+=QgI3&6hu?hUdHf2At-o+<&qByR}0L$ zn1>GvEdtZP7(OT{j8R@^%zsk$FAB_YR6r;Y#a1hSMO@mYhUpb2te4+odavV@FTKn3 zUe3^q%S|u8zEEDMGQGTgDBmI7P8))C{yZwow$u)HHZwc`_1-O>tI^?r61+>Qb5yJU zkIA098hq3ARe4y zGTw}h?*l@V@qWTTynC?5F}<0M?zCkICgJOG2L5-0GiAxnbyZo+Qs6|$+Z|?=s_l6A z(b4_kq0=*y&jmGS+6xUGYy4(-+?Ban@T=}ham-bdSisdiMgli0Moion9QDv3s7H8& zwdfL#9j)NuQa>Zs$!Bk*smcu&%EV{H^N7#d)*tY+9q_0JJZN@Y?DyKxz|dJ}VDfDQ zH@?O8Ohx+GSn60Qc6=-)KL|jynX%MNiFRTvB|i;7wAr!LY>}2ZIhK+i2_RbOBLOyi zXaKhcc&TN*U}KDvFiz>Ty1lP2g_rvzkxiFj0SAHkjUdfh~{H(`4RUa zoFd2*g$J0SW8LH3V@BglXgmbZqvPISs5?xaIKqC!Ed9+Yc2=WV>vyZPKe@I3(&Ge` zpCzEY)djTpi;Ypa#ep$uwDUGc9IbezkjB$Eql2>?pWI+{s1$E8)^O+R{EO1Lmc|;f z@A8D^$|9wPJSP9na7=G8+L4qV;TdaWb|GVpO7S+Mqbxf^TxM`BteiXEp7RBV7AAXFI36lRao>f#kY{~wIzK0jK$0x=CE``GtP?``tA0@C2X;@HE#7&V-!{3L9+y_Z9P+#PxZnO6JrvGcX6X#5`4T{KwVul7mc`!YPUXJ)a+NCmBkqY6^cA^x z@uK7(Uf*I#myirGk}B7Vn?=}Q#kU8`?o-{Ze7?l_y_IUfcd?_|<>vKH^ZE)m7Dk=4 zAaF|h)?77dpyUPGVBSEVnsbo__}tHmspbtTJ{V><*TOh}FAtiF;Pqx=rOVF}ny?5i z{34-QU;Z7k-{VV!W&>ZalJNNd{^Nsu%PejLS$NZkzwNt}rSZiZS&XCnfM7y_LpDCf Saf3MktQIpAJ{269pZ~w)MlIO@ literal 0 HcmV?d00001 diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT b/obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..891c14cc161b6a178923a02d5d7af4e2a55e0467 GIT binary patch literal 9819 zcmeHN%W~V+8K!(mD>`j@$@G>^d+KBoaw@TsY|D;j(kV?r5^9QMK+v|@=>j4_5itlb z0BBoTca@juzKhOu+b75q^a--)uG1$-zwZamA!$*P-FlHl=$Hil^Pm5IJI6Wn2cdtu z>R9#N_4~Vf<*jo0cDcM+E*l7*0l9y=qYk|+QwRQVn8cB)jPi%ydEs;%1+~5xW`2KE z^9R#v*&PL`8pQqS*pD(5dTFNoL6G?ag`M?D5`=1NdrfU^Y~87q?Uw7bcY6)jZnyHC z<9IL)eKqihLFA`uIF0&Q5J#!XVwL#bKtWP9jFYjK;RhUsLFlJz%8Ldn8~G9Oo+aR? zcI|GbSwGrqx7-{_^?~mNQ4pOFRh@*VlMz@X@mSu|c$)P6oB@c|lpU#voI*8C{WapG z%g8hkzVvi_9EYh2pd)QuSjtQM9F$8w@%m4^69`}4>$SwL-Esvs+tE%{ow|FV-fwqk z^LkS~w4D3xu2o(A<6dFwKb05oY4ud>JMoefKB02r1sF-C6Tcq}1ITxLDx_@sLA4=#G&EgIS1*2Z|h!5Un)gF!YfkPkmCpkS4WC0)()L&fM9n zH>{fK`Z>sU4%OD(+UC}p+QTZ63V8+{6W}KhC+#P}ghr`V^N@Pv*sjIWvF^6l=hAI` z&u&^>wTcxc->%hlvFxb#A6Q4=d1yC}RM-B4CH$4scI%8q;61b(mTDZ-o%OEecGY3M zv)*exXtf`;$f4ud59_X_a<;t|mOIw2a_WzOWjETp);d9UYrnd>`eHa=BCC{)bV<#S z>QE>`bNF6=q#iR@`y(&$`tXrT{Y*U@1z0FzF4eWACGXJgfRyWJadJxH#`4I`MRB9)_}EX3 zKny;EtfiYI@zY@74{GJyX9!g|4Z(q^Su<|SBe(F~Odi%@##xGdP+oE(?Lexy-Q1xO z8b~S^(Fc?4T;?1WSTrDiJVD;Y>IC-Ib)?8JQ^bQPZw{;~Mc$KxsU0X!I^O3Zn#L*$ zp^B&3WSSAejXL$A=5hR#m8l5ev3E)rdMXUyOkfw1AafZf3tFP8L^?t|B;b1!EPvB>xRl$?2YV!hkVH%4Rk!A=lHXOU-wjD@(f^MhI6-c^BpYqUAh4?zu(D6_> zhbWL{#fMz8a?jEbPZ2jutz4dEvEG6(&U0iwZ%|~wWP%{Zw6LbqQ9KO?c{8O@vv^{= zoGUR!M=ufrRb5(+A7E1gpQJ!Xb6OVjs=|VO0yMGi1_NsA&YddEWn8&zA0$QM`kssr z>^2KXScO5*NeoIHv3Jkwsy6bR)}f2`-2IDQ{3W6=%W-g;dwXBAY=; z3I}!IJaJBRi_`fET z>LuMn50OL6NV=9)IEv2leQv3m=V(#BXVsMUr7lGl%uJ2ukL2f)ZUl>KxfaXpmrW5! zh{e3A=QPgcJB?m~Go?5O@zuo8s;~p@>^F}(2MGT(^P)bYPLDdQ)U+cqHkS>fWPTdJ zfsoT^UO$R)Jl`e9B=i&=wX=f6sM7@pxmX;=Oe__p{kLl4`5r#3wvuOXA}ZwZDGJd? zvWEDDh(0F9oo%67HTl4l>Au<}k+T36)iFu`J<$Dp+X2 zS{wODK&l%^|%B{9*b<1CURr>evtJ10qzc9JYNg#U`qq1a}(k3xXFgxaAt}2e> zBG<*C4OKZRfVeapeL(b|PvV3pMl(JzHH(8G_P{hTHYGS$VLRC8#}_D)jc}^gCrBfG zkKGjZD{_^J03H`XoN5+f;0`FznTg;q*Be2QP%1Gyodd z4BC3YrY_91i@hy#9!xSEVi1D@q8-Ovc#U6-ba|W8RE9d1E=V{Rr8taP4UCAk)h+B= z)a4lWIGH+y&5Hp`95;#6G&n|s3h{vS$7G7D3FJV6AqDfJgmr$AQG^ssjUEZ79mP}R z`YDI5oa_W~7xT1ix9t30rmDQbAYU|=ndz3FBF+^*FS@WF?hPm*{aoDHh?jATBt1&I z8JKxg6iPB~W)9m!sOmPxTL5!igerqG3`ondi3ZKDm(L;u7j=3cKbnBRX*<3cU8k`xt3$?R^@7- zSn2l2T8=s(WVasLUHg91Qf>5xuGK_%cOZx>?;Tt*0D!v!S>?^c=7uh3hqyOzTB?oX zU(;?C1YE~{V6}Vs_FfAZX3cusskgekuW+pWUbF6~ZnNF7%-bW&-al~Fp|xxG4k?)B zXwJQ^<%n@;(XM+0aq)x`W!pK#706k$!7!V5Z>w9|YU|!T{8V%N$^m)=jG3FOcyW&? zM6cDt0zue&@3y*o`?k8XHNV%j9=ozp+zONrx7F=C+iH6Q&ZRh2?5sCo@fI&zh$Wc+ zUjTsSHxB2F;6b^-{UCDNn`M)s@nF^Y6=^?*RDb$`_??;dkZg zwbFYlcwK_H;?4n=ZJJv)k7qWO7C5bZaVe+Ur1cV;3`;!R#osT@9@yYY=}XX9#%q3? zm=4>%58$<{S1&i+X6f_N=PUPw#x3*Z1qdcnNF} zdlllZi2l7-qkiSp(Bbk=O9vHnZ`+lBcWN~2-7cn$N-;BFh&Xf{4n?L*cG_LHm`d17 zRi%TY7oVyxXRNIBU>U;$tNGA!?M9u0%j@QOxsv#|o7bk~OIh`GGDN_>N(f#pm9|Q& z#^5jKwi$yrnLigM&_Wb4=`Tjd@~u+YwGXYX(>|=Xih^=cih=__S44K<@D^UB(tQ^X zt6YSd_~a;8uy*6X={2p|zUA(Dz+(I*`a)_>s3nwMMp2LYrh8y@n35Yd<5w>3mIl0;QQG^>?&G(^PV*UvSCDo`3}P~5;4 zC(;ToA-~cPF#x|rVrujwE-gSr^99HcHIA5#1Z6wDDb^P$3wPWkF17k4AE=Q8E;lsJ zK#Y-%Em|6f#D&ezG(@NuX^pk)D~hoB z6>&8bSrHVjXh_N6iUBFj-|%-~w*&!q8;59)#u6qZwT)N)qp66iNZ06OY;#}ZkREr6 ztz{Viiizj^;U^kZ@{Ht+sei#G?*1_!xXYO6{WB1;xi-xLhfL#&oD{;-5Uo_{0}U}s zi5-{HGp05Yi*^h0N$?Y54Ebx#!MNkE8e+7XXoxnBw$h3Ss-?LCG#Uz*K^2(>aUIl_ lONW~LuSz&x$b7g1ly`S=Q?T>NKmYY-`04G^-#`1ue*uQ5HM#%* literal 0 HcmV?d00001 From b5ccfdc4e741181ad235b78ce04c58723dce47e2 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 1 Dec 2025 23:39:59 -0800 Subject: [PATCH 6/9] Fixed incomplete description in documentation. Changed parameters for BUILD-COMPOSITE to simplify, and enable keyword :VERBOSE parameter. Added some VERBOSE progress messages. --- lispusers/READ-BDF | 131 ++++++++++++++++++++------------------- lispusers/READ-BDF.DFASL | Bin 24256 -> 24645 bytes lispusers/READ-BDF.TEDIT | Bin 12137 -> 12957 bytes 3 files changed, 68 insertions(+), 63 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 77bf8c041..b4ee9fbed 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -4,16 +4,13 @@ "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10) -(IL:FILECREATED "30-Nov-2025 17:43:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;75| 50310 +(IL:FILECREATED " 1-Dec-2025 23:07:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;3| 50528 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS GLYPHS-BY-CHARSET BDF-TO-FONTDESCRIPTOR - WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE BUILD-COMPOSITE READ-BDF - BDF-TO-CHARSETINFO COUNT-MCHARS) - (IL:VARS IL:READ-BDFCOMS) + :CHANGES-TO (IL:FUNCTIONS BUILD-COMPOSITE READ-BDF) - :PREVIOUS-DATE "30-Nov-2025 16:05:42" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;74| + :PREVIOUS-DATE "30-Nov-2025 17:43:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;1| ) @@ -305,65 +302,72 @@ (LIST CSET))))) (LIST FONTDESC CHARSETS)))) -(DEFUN BUILD-COMPOSITE (BASE-FONT &REST FILL-FROM) (IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth") +(DEFUN BUILD-COMPOSITE (FONTS &KEY VERBOSE) (IL:* IL:\; "Edited 1-Dec-2025 23:07 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth") (IL:* IL:\; "Edited 26-Nov-2025 21:23 by mth") (IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth") (IL:* IL:\; "Edited 16-Nov-2025 18:25 by mth") (IL:* IL:\; "Edited 14-Nov-2025 17:04 by mth") - (LET (MCHAR-PRESENT FONT) - (UNLESS (AND FILL-FROM (LISTP FILL-FROM)) - (ERROR "FILL-FROM is not a list.")) - (WHEN (LISTP BASE-FONT) - - (IL:* IL:|;;| "Allow specifying both BASE-FONT and FILL-FROM in a single LIST.") - - (SETQ FONT (FIRST BASE-FONT)) - (SETQ FILL-FROM (APPEND (REST BASE-FONT) - FILL-FROM)) - (SETQ BASE-FONT FONT)) - (COND - ((OR (STRINGP BASE-FONT) - (PATHNAMEP BASE-FONT)) - (UNLESS (IL:INFILEP BASE-FONT) - (ERROR "BASE-FONT ~S doesn't exist or is unreadable." BASE-FONT)) - (SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T))) - ((NOT (TYPEP BASE-FONT 'BDF-FONT)) - (ERROR "BASE-FONT is not a BDF-FONT, nor string, nor pathname."))) - (SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT)) - (LOOP :FOR FILL-FONT :IN FILL-FROM :WHEN FILL-FONT :DO (COND - ((OR (STRINGP FILL-FONT) - (PATHNAMEP FILL-FONT)) - (UNLESS (IL:INFILEP FILL-FONT) - (ERROR - "Element of FILL-FROM (~S) doesn't exist or is unreadable." - FILL-FONT)) - (SETQ FILL-FONT - (READ-BDF FILL-FONT - :MCCS-ONLY T))) - ((NOT (BDF-FONT-P FILL-FONT)) - (ERROR - "Element of FILL-FROM (~S) is not a BDF-FONT, nor string, nor pathname." - FILL-FONT))) - (LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT) - :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - - (IL:* IL:|;;| + (LET* ((BASE-FONT (FIRST (SETQ FONTS (IL:MKLIST FONTS)))) + (FILL-FROM (REST FONTS)) + MCHAR-PRESENT CHAR-COUNT FONT) + (COND + ((OR (STRINGP BASE-FONT) + (PATHNAMEP BASE-FONT)) + (UNLESS (IL:INFILEP BASE-FONT) + (ERROR "Initial font file ~S doesn't exist or is unreadable." (NAMESTRING BASE-FONT) + )) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Loading initial font file: ~A~%" (NAMESTRING BASE-FONT) + )) + (SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T :VERBOSE VERBOSE))) + ((NOT (BDF-FONT-P BASE-FONT)) + (ERROR "Initial font (~S) is not a BDF-FONT, nor string, nor pathname." BASE-FONT))) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Initial font contains ~D MCCS characters.~%" + (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT)))) + (SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT)) + (LOOP :FOR FILL-FONT :IN FILL-FROM :WITH PREV-CC :WHEN FILL-FONT :DO + (COND + ((OR (STRINGP FILL-FONT) + (PATHNAMEP FILL-FONT)) + (UNLESS (IL:INFILEP FILL-FONT) + (ERROR "Subsequent font ~S doesn't exist or is unreadable." (NAMESTRING + FILL-FONT))) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Loading subsequent font file: ~A~%" (NAMESTRING + FILL-FONT))) + (SETQ FILL-FONT (READ-BDF FILL-FONT :MCCS-ONLY T :VERBOSE VERBOSE))) + ((NOT (BDF-FONT-P FILL-FONT)) + (ERROR "Subsequent font (~S) is not a BDF-FONT, nor string, nor pathname." + FILL-FONT))) + (SETQ PREV-CC CHAR-COUNT) + (LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT) + :WITH V :DO (SETQ V (GLYPH-ENCODING GL)) + (WHEN (AND (LISTP V) + (EQ (FIRST V) + -1)) + (SETQ V (OR (SECOND V) + -1))) + + (IL:* IL:|;;|  "Need to change this use of UTOMCODE? based on the CHARSET¬REGISTRY of the XLFD of FILL-FONT") - (WHEN (AND (UTOMCODE? V) - (ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V))) - (CHAR-PRESENT-BIT MCHAR-PRESENT V 1) + (WHEN (AND (UTOMCODE? V) + (ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V))) + (CHAR-PRESENT-BIT MCHAR-PRESENT V 1) - (IL:* IL:|;;| + (IL:* IL:|;;|  "What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?") - (PUSH GL (BF-GLYPHS BASE-FONT))))) - BASE-FONT)) + (PUSH GL (BF-GLYPHS BASE-FONT)))) + (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT)) + (WHEN VERBOSE + (FORMAT *STANDARD-OUTPUT* "~&Font ~A supplied ~D additional MCCS characters.~%" + (NAMESTRING FILL-FONT) + (- (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT)) + PREV-CC)))) + BASE-FONT)) (DEFUN CHAR-PRESENT-BIT (BM MCODE &OPTIONAL (NEWBIT -1 SBIT) &AUX CS CC) (IL:* IL:\; "Edited 26-Nov-2025 09:29 by mth") @@ -461,6 +465,7 @@ Y)))) (DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1)) + (IL:* IL:\; "Edited 1-Dec-2025 22:40 by mth") (IL:* IL:\; "Edited 30-Nov-2025 11:59 by mth") (IL:* IL:\; "Edited 28-Nov-2025 17:39 by mth") (IL:* IL:\; "Edited 26-Nov-2025 22:47 by mth") @@ -877,11 +882,11 @@ (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (3235 10173 (BDF-TO-CHARSETINFO 3235 . 10173)) (10175 16397 (BDF-TO-FONTDESCRIPTOR -10175 . 16397)) (16399 20017 (BUILD-COMPOSITE 16399 . 20017)) (20019 20768 (CHAR-PRESENT-BIT 20019 . -20768)) (20770 21054 (COUNT-MCHARS 20770 . 21054)) (21056 24091 (GLYPHS-BY-CHARSET 21056 . 24091)) ( -24093 25518 (PACKFILENAME.STRING 24093 . 25518)) (25520 34886 (READ-BDF 25520 . 34886)) (34888 35211 ( -READ-DELIMITED-LIST-FROM-STRING 34888 . 35211)) (35213 42211 (READ-GLYPH 35213 . 42211)) (42213 43494 -(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42213 . 43494)) (43496 45913 (XLFD-SPLIT-FONT-NAME 43496 . 45913) -) (45915 48927 (XLFD-TO-FACE 45915 . 48927))))) + (IL:FILEMAP (NIL (3029 9967 (BDF-TO-CHARSETINFO 3029 . 9967)) (9969 16191 (BDF-TO-FONTDESCRIPTOR 9969 + . 16191)) (16193 20126 (BUILD-COMPOSITE 16193 . 20126)) (20128 20877 (CHAR-PRESENT-BIT 20128 . 20877) +) (20879 21163 (COUNT-MCHARS 20879 . 21163)) (21165 24200 (GLYPHS-BY-CHARSET 21165 . 24200)) (24202 +25627 (PACKFILENAME.STRING 24202 . 25627)) (25629 35104 (READ-BDF 25629 . 35104)) (35106 35429 ( +READ-DELIMITED-LIST-FROM-STRING 35106 . 35429)) (35431 42429 (READ-GLYPH 35431 . 42429)) (42431 43712 +(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42431 . 43712)) (43714 46131 (XLFD-SPLIT-FONT-NAME 43714 . 46131) +) (46133 49145 (XLFD-TO-FACE 46133 . 49145))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index faa31f3d52c8e8996ca08918d24cf61612c2c854..57065cd10723b8746ff4fcf54e79596222de8de9 100644 GIT binary patch delta 2654 zcmah~Yitx%6rMZ#=!-rqOTk)UXn0v&EZZ(E1)!}*V5W}@o>CTxTKIvwc^|H%kc>% z3ko|%1CJ^1f;YaCBk85R5b}UiHjXd5zxW0;2MVSYHYq6x2^`p%>j3c5`DL8#bzXkG zzv!m^@H~MNT4swc@0yHH#Upvs0hDxVjQ9g&_se6XN<$!0a7r(DOq*B9v3ZqA9$g=E zT_#8Q6b<#=q;l%~GS0?TYP?-#3N$Xs6)BjGM+({BHLVxSs}hds1te0)E5wLvG(Mb2 zMv6}9MUU$)+h}4q{*3M-2j+erj=!M0M1rYD56l6F3pt*9=w980!{&zL<7F(^H@^~* zqG`QQnIB#pSuw2_VW6*YfdY}~8JipA&t#%;eAWDNYDwhfcv#Q-YzeIBbU>UOyLM42 z5Nx^D)8;K@M$o7Eea(Ki9tt*vf@LW!mx#ya*e_+XD6y!`G93-N7Bo_9I|-j#C(Vo& zxw%d^?x*11kutz614Iy(-2Yu*_O z$Xd`X(;q9G$vnnFK1tPqxx&r9R6Rrrk38IzBE{d3C}B&S6{xQ_+`6W=GDP^At!8GE zFW3kR3cv+y5}r!c9p!yTz=)1oG|pTOW*!ro1oDezRt&9c=+>V` zL0%ZG$Fc~0T3(wOabeJvo{&x3$`+B`E&_|HjV4v8m)%}ZCEcssncsZ}=DYdP@1id$ zuaNSzyh|dLM+jqI=pN>)Ck_%jVvh(y#4>Gl{ss^z{EXmnn!5Mg(n8D3@XM+aP=a<9 z@!hmty`9+Upjvrn3#0v)s7zQdx3|J;yA8|R@Ii@D`h{9m{l7A*ER#s@nX*TBh7 zq#FZE?aRYVoan>EA#k^$8=-yo8ODPk{CNbRj2(EWh=ThBx}A9b#Rw9Uj1~kt{M>lB z!Hq0-XWtdG?gDbIQ;#M@Jbj1U2*OuXP7pM5rmNl>!nuC33nuGk=Pvv86nH}!qyAi2& z#JzFEoi*YXL`=-k!dBmwg$>~_+So@#3I%zWNzQRiaehu{VdXB(N;7!_YZK&>74)o delta 2149 zcmah}du&rx7{BMXd$aDrDzLHbDr1AW>g?J*LE5b?EA8#Ay?4CYtsA4G1Gbql2pC}l zGJ;Z&?F6_bJc5#Fd~P%d~sheM0_i{VS*iRO{;P`7{7HKqp?7;z6bYeu?< z!jwPRN5yH7VFBTYYuEzevlcXA;hUk_#Z?=)xCLZ>D)@*dTqtGC8-3g$aV@N`WfP5c zXV51}8p~ti*Y9tXOoP|*FEw8dPr9J$=s5SI3k6;t=e}_R(K;dyyIGqO#*jAT=Vo2p z_jQ>Z(+@J~gA&#yZz}vjIH-$@P_ZkG9qq^3AMq`KWp zL!UtCHihrbl;F2{B;jtTIGCjDRr5uwA;Mrwwb zDT_8yFB3fOE;B!?Mz62HF$@&fR9;5UhKrf>3Cx9i`+|Y~4W9J+8BV@u$mMf?Z?_Tat zZK#KM1HQR@9GPOHPy100*=EXWyRT7_?GV)BzgN^{YSL)AuYqyl6&7!nYY7YIf>{+i zWBEa=CyUQ1mldnWX7$+&Qj6kkQOfa)_F{bnTvDV)G8!d?TsVWV%520__WUw>{0_+{ zS{2el3)hb~QkVgERLemFBfe`F5QhsKSCJpzbd+VaJwpTBNE5`{@FOc1r?%yRvmw^B zGNLI~c(OVmX1mK?x3kGky4O_UUsgSy)wvV|oqCpt%UrLZir96RfJ{3ODL<1wgysO= ziL_vMaa>T1Xc}z}o{n(`$bGn2d}ppsjilJ@Zl~x}v~J*A@h!0sX>dX`RVbwFLsO-> zow7n^sx@f}K);stYR7G!n%e)JqehJ&q3lR2A7DeU>ic7#dFE>8`N?#=6#~yvxC~$$ z{>vxJK|1*lffH{y1)wt;DeQ9r{a`6tVxlXa2mT?DFVsm1z?Ks>2(uj zrEv266x(g7gIw7pa_M{uJN>CF(3avo>*u35KC#|fH*@|;@_JeE@l1G@eO7+NW PM6Sj5x5jymK9Tqr=b&O4 diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index c2de2f3623180427e284063bca4a5bd76341660a..76027ebdff7471cd05e32e8a3caf9e4019603790 100644 GIT binary patch delta 2949 zcmb_dO>7%Q6duQIQadSxmhcnu^BOm5)wk$IGfl~vUa?i zq67(FkT^gk&~QZvE=au~lp9qKa6{ZVaD!VB65@o!f$+Y!o@o|yNyT9|Z@zi&ec$_L z)_L&Or|w67GVfO1oprZGb6>yv+v%aj(yhuWrC%+)K`*{uC@+*&3)zHzulKulrRGw& z+jLsajvH`|Uu*1bZ_v6+4lNZ|D>=#(1KM%+L&&dtTiY%zb?$vKQ+wO!HP|%=qVLm^@4Rcva z7B?xgSS+trLS0$?ci;Xw$J-~@3tIcs@IqXFer8jD7SD|YJVCS7*lM}HPmN9LtgF1t z>7K;=K;5ecb!VG48(yHtlBu&fnx}Y(_^C zB;8sLnX+joYsNDmfKZ{!20+0S;&T@5cI$j@0iHN9ypWf!)Cv z>7~(`SWF*`zNx<)y>nO{8;-~Cs15zch3nbOaw%UZ-=euIv|KFHm28$WEBQt0!u7}F zlf8pVg@xn#J`JC+_=*3e_>m=_uu#90n$&|6yPfBLZ|u?KXF7JD+_ig5zodU0ojshJ zJQX`nN-5T%)Hpv01aW;ceK8i-JLWwc2dsKzTT;dhpjXl(u`#5k4A#ecIqaLN(-zRz zE=^oK2FDgmo`Ai)>L@t4G}Q)%T9GFKkfcE*6L60~9!CH~=0UOqqa5_}6A^UH0H+Wj zkMB~L(m~ovtr_SH0^m;?1l`pLKWT$Ny)=rlV`Zgonq;VkQsF``VL)!tq_i!mjEp4d zgAz+&`dE9!18iS4eMA>t?;AwgJjbg!gIMvB~!7oYt}OZp2O{U($c;u@0s{0_K+ygkEsK zNL%4*KZMZ8{;(M1!=EFR*?FuWE4pI(;QEV+GO8s*XZuqloq;UdBf@i+p435+bFl zkz_O!1F}(qk2W$csx5=K2E-29mMTCpDY}mHBYIK@AmcIuY}j6rFL?HnxElN+?a*@X~yAY-+otsHlPk4zX1iC$$_4HmItTP85s82HT}F zQaei)Wr6g>0wKhXMOUr7L2Q8X8`#rDrB>>?J0$M8&b{Nwh=s@Rop|ZEo+hwsy=`v*(Y+-EQsfBCzN8O}}Hja-~kZ%9A;7n(dpRjyVwD z-|@|EtJgPMUB7v`@82|=1LGBIwbJ^k@wmp2E2PQfO{%gT%Gk$82U)*GY~2tvoi2$F zjNk5e2d2{w)9vo$ww+6UkW_BlN-m}vRLn}Hu~w|vACj|Ui+?2-Crqnn?9=4(T;7zL z@csbXx&(C~j_q>ArWwzkDw(aGIf6q=I8a`NpBE^Y(DhyXel$IF94e&zYuQ5(Az&2`6R$$($y#e=`fC@3gESj6+W$o0w%FH+FE0wA6hUOj*Wj&nnxNeocq>w<8>Cuz1M2&!kIs5%PQQnw`-Rbz$K zk-!Q-DiRW?D7TCt=7F+G2#?ys9$>aCJX{w(-w47qZ_w-=K~#MyM5upm`I$hh0ix4_ zKpg;=18Z1)Y8+v$6N0=(10*;wo0pE$;3XhPWu8|sBjNyh24lc##^o5YE(jCC(YIm< zc8Ym42FEmtsAHoT^v_2N@|va_CeCXJ7mu1Xwoa31@oKNe=&4f#9w93Td%hw>B04L8 z+JajgZHIk~SodBm=JObWV==1v6O3@!3K&F)^xSCCdYu$ml`KU@S@!$WywFSq%pmITqQjkJqORe^0oTiR&AS=uQK)+a~%dRrv;6hidAAY3Z4z7S;8*O=%f hS<$xs6oiaU@cBgnj%!=Xne>Zu^pH+{>N;Ql_8*G^)sg@J From 27d4e7aab25f4564888dc37afba238641aab2e02 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 2 Dec 2025 16:13:26 -0800 Subject: [PATCH 7/9] More bugs discovered and fixed. (This needs regression tests. "Harmless" edits aren't!) Documentation review changes. --- lispusers/READ-BDF | 31 +++++++++++++++++-------------- lispusers/READ-BDF.DFASL | Bin 24645 -> 24636 bytes lispusers/READ-BDF.TEDIT | Bin 12957 -> 13003 bytes 3 files changed, 17 insertions(+), 14 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index b4ee9fbed..062419e45 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -4,11 +4,12 @@ "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10) -(IL:FILECREATED " 1-Dec-2025 23:07:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;3| 50528 +(IL:FILECREATED " 2-Dec-2025 16:10:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;6| 50944 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BUILD-COMPOSITE READ-BDF) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE + BUILD-COMPOSITE READ-BDF) :PREVIOUS-DATE "30-Nov-2025 17:43:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;1| ) @@ -198,6 +199,7 @@ CSINFO)))) (DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (IL:* IL:\; "Edited 2-Dec-2025 16:10 by mth") (IL:* IL:\; "Edited 30-Nov-2025 15:59 by mth") (IL:* IL:\; "Edited 28-Nov-2025 18:03 by mth") (IL:* IL:\; "Edited 20-Nov-2025 12:46 by mth") @@ -205,10 +207,9 @@ (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") - (IL:* IL:|;;| "Check valid required arguments") + (IL:* IL:|;;| "Check valid required argument") - (WHEN (AND (BDF-FONT-P BDFONT) - FAMILY) + (WHEN (BDF-FONT-P BDFONT) (WHEN (FONTP FAMILY) (RETURN-FROM BDF-TO-FONTDESCRIPTOR (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY) @@ -216,7 +217,8 @@ (OR FACE (FONTPROP FAMILY 'IL:FACE)) (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))))) - (WHEN (LISTP FAMILY) + (WHEN (CONSP FAMILY) (IL:* IL:\; + "Because (LISTP NIL) == T !!!") (IL:* IL:|;;| "Assume this is a FONTSPEC.") @@ -745,11 +747,12 @@ (DEFUN WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE &AUX FULLFILENAME) + (IL:* IL:\; "Edited 2-Dec-2025 14:47 by mth") (IL:* IL:\; "Edited 30-Nov-2025 16:03 by mth") (IL:* IL:\; "Edited 28-Nov-2025 17:56 by mth") (IL:* IL:\; "Edited 26-Nov-2025 21:07 by mth") (IL:* IL:\; "Edited 16-Nov-2025 17:32 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) + (UNLESS (BDF-FONT-P BDFONT) (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) (DESTRUCTURING-BIND (FONTDESC CSETS) (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE) @@ -882,11 +885,11 @@ (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (3029 9967 (BDF-TO-CHARSETINFO 3029 . 9967)) (9969 16191 (BDF-TO-FONTDESCRIPTOR 9969 - . 16191)) (16193 20126 (BUILD-COMPOSITE 16193 . 20126)) (20128 20877 (CHAR-PRESENT-BIT 20128 . 20877) -) (20879 21163 (COUNT-MCHARS 20879 . 21163)) (21165 24200 (GLYPHS-BY-CHARSET 21165 . 24200)) (24202 -25627 (PACKFILENAME.STRING 24202 . 25627)) (25629 35104 (READ-BDF 25629 . 35104)) (35106 35429 ( -READ-DELIMITED-LIST-FROM-STRING 35106 . 35429)) (35431 42429 (READ-GLYPH 35431 . 42429)) (42431 43712 -(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42431 . 43712)) (43714 46131 (XLFD-SPLIT-FONT-NAME 43714 . 46131) -) (46133 49145 (XLFD-TO-FACE 46133 . 49145))))) + (IL:FILEMAP (NIL (3113 10051 (BDF-TO-CHARSETINFO 3113 . 10051)) (10053 16503 (BDF-TO-FONTDESCRIPTOR +10053 . 16503)) (16505 20438 (BUILD-COMPOSITE 16505 . 20438)) (20440 21189 (CHAR-PRESENT-BIT 20440 . +21189)) (21191 21475 (COUNT-MCHARS 21191 . 21475)) (21477 24512 (GLYPHS-BY-CHARSET 21477 . 24512)) ( +24514 25939 (PACKFILENAME.STRING 24514 . 25939)) (25941 35416 (READ-BDF 25941 . 35416)) (35418 35741 ( +READ-DELIMITED-LIST-FROM-STRING 35418 . 35741)) (35743 42741 (READ-GLYPH 35743 . 42741)) (42743 44128 +(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42743 . 44128)) (44130 46547 (XLFD-SPLIT-FONT-NAME 44130 . 46547) +) (46549 49561 (XLFD-TO-FACE 46549 . 49561))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 57065cd10723b8746ff4fcf54e79596222de8de9..81ccb5771c9f8ccf0b0f5c1157d7f8d5b71b1a12 100644 GIT binary patch delta 670 zcmX?lfN{?O#tAX;W?aGfrA5i93Tc@+sS3$Osfi`2DGCZkx-O~7x<&>@rV55;R)z*v zMy6bDj=?^t%0fz0i&GLSbrg&gfXY*IlTwQmKzejwn#?xt+QBM}#jwe(Y!-}WlM@Bi zCwEG#Zsua=RptKZaF_uI7HwpDK3PpCnQ_YG$vP2?Hk;q*6f*JMn9<+E;^P<`(!{{P zbZBz6zO?t&nLZ#+>r5cYcoD>m0W&Xy_;+SZ?O}2Aj0gg8j?WAPQTu>moH1_xej#p- z&aNPlbu%MC)WXRZ^+oDu0j*&3^b2tf@&gG@0CIVQLxMd0+;u|(oE?L~Iy!)&>=4la zkg9mFl`la|qZyNWID(yBJ$-;$W^x0C7(Ri`XLt&X06GBNrC?23nR`mqY|&?+YKC4g^HU(uNH!POFi&S!Cm@p}$Unp} z#M9r;7|3A(hMb103Wyc#8RaSpQtIaD>**88G}DO*WaZTsd&!xzK&+{oeGJn?c(|SX xLqhz0bq$RT3^wm|Rb}Pj2D%n#I8emMaPwQQNM+D-%m4rY delta 687 zcmdmUfbr-7#tAWT#$3VqrA5i93Tc@+sS3$Osfi`2DGCaPx-O~7x<&>@rV2*JRtDx) zrbb+Dj=?^t%6#+lQW7h56bu!Bs#9~5Qi~KoT6ExgHtycRDvZUf$!%;FjK-Vyvqh@% z|8qFZ00a{q8!{GcWcn~!Stprmg5$)DhRleG9<7txbs`w`H$TuRWa4`|qrZp6$1ymh ziGhLX{N#9j>H0%6eL$Q^Gl3-IMG!L+%)AWZznn3(hsDh^A_&B}GBXfFod$|=#<=wpqGF`hm?uI`RLdX7QvAi?E88`(VlLR^FVK-{@NE^ly1kf)!! zZfJnBV{kp#gsDJbc8G8QNLdcp2`@oR`x%pZID(yBJ$-Z?FmPZ6K5`gpz|$0zieVV1+_WEI=#%Os+AItv>=3W%dmM zd$k3~W_R%n4)Ae|1UbTUrW1%Vo9P0gG$52TgyIEL46h;7HLyyC-C&zOgIqfc%={Dz zG?LB5HO$l5)eXqx2=Whc4Ds~$GY4{5fFY^jssUmJdq%lRf|R;B`g;0AGR<^i0$KT} z#a?peED&qaW(UJG5pFIg|Bw)WUtLoJYfQ|*4t!rvzviY%BBr_+6k7sa* NuBoxY!O5S?CQf&n?$;`_sCFJ`|mHdqJ=P5}f0Vq+wH2oi@(cE@-XcE*~W#WEk- z8yt)fqLmv_4oEqK3(?+!P(%(dAAqoss8{1Eyq=Y&xBK<0_o}OU=9l2V z;NfjE@yDIZxz4LxV|^~Db-wG%_wG7z_T<$0$t$+uFWMgi>)W%_7iTVCI&-?S)IZ-d zV58X1EzZvcVbhlKhw|ko%LArjOD9)QTlK>*N^DfEwqjckZ88_w70J+V1g@{YV9K54 z!GBHL&dk-DHV&#$qY;EPKdDEdC1jR75Z0_GtrT1!Kf4&UtRDxq8V7`i*N7J;O?c2w zY@>zH2H}l*9EGHoj9Ndeam<1rCeUlxsFgJ9wZKNRSPxTZGx4uqPd#dN$|Q;6McYi` zRyAqGLFezSxMw4w+2TxL-rX8L;Kqkv@M^?8 zE53MCIFSA&?m;n6dy{Ud2+m|@saVXBD1JF_qkCQ6OPZg`BRb|QKMl%$FR{izHSX6+ zeqBGdhH|9g!GNpdS&euVGg1$iq1AnfMmO_@3=-yDM{;kUxc(CnxZ1xg|kvS z!!M_Ce;pp?S4JcFEJ$XvL}U-ev8aw#Q0uj$D+)S=45IfRx%7C{QR3ye%1IX)7LedA zE(HvIL3pdnLR))HIH|=d2d)|#st0Xzl=c|)#rK9y^;`!9;adpP-v#0NP?XWHcEk{@nX`^Uu#wh`4qD delta 2277 zcmbtUO=uHQ5PqAr(KJ$RYgD2po3sttq?V+J&{M6}VoGC5^`PLP(IyzIv|1G`${xK~ zu&m(8lQ(a&c=4oo@DIIv5qebcET{+HH_1%gE(o!Kea!pbH#6VNyq6EP$F&D{jN-Gq zXF}bVYgWB+edUJL@IHl>!l8wlHy%lMC8j3IrJ3{A)#`2QV$G^riw(_Ls#~|Ji#Ka4 z-fGXX`Q%rx;m!2FHN5AsY{W3!FNq6oG`Z%zNybfcO)a?VsiZreird+8W%A_QX{%VU z%B4B0VB1!9c5=!J;O<0bD7;&#rt?^bj=fuU+>+eRou_qouC>0Gt&VkCwDF%syT4OI zNbOa!>xN;v8}^`H^SSmqo4e9yD*QsKORpm^P4{CiJ@^-F948n@Fv9waz%bqZe9i#| zU!`R>4Itf&5EJJiMs~pf0tX67#v#3lGQxt6Ft7~Yo&x!^V<%GUOlBFB3$Z8zxFx1Il9WmYiQ>RTQg9sV6DZUJ9FOXcdO*6c++&2o z9MHQWBa%JSMv~e@uCEMH4g^BkdPbjzEBfKuhto7EQ9H(bLCTC!)B5yI^ixbMeksUX zVK1(c=8O>Aae{GC7(==5H)|LM15}BRtb~ZFQ;cx@;4DsTrX(1UD1493H7BTJ7$nb^ ze1E_##|R}w9numB{f#*8>ydc}tSr0GKtZ1lAkt|XF*rn)rUAjG-5Vg(Bq75fRdDUm zpEC7R(7)zOrs}|vafo{m0grOg6_yk}J={Sx05UQkg8>e=!clP_gh2A5ne;C~BKj=H ziNQb|DpisJkvC3}fs}fAYqj`GHgj9qxF>wZ^=Mi10sbw z Date: Tue, 2 Dec 2025 16:24:00 -0800 Subject: [PATCH 8/9] Removed obsolete/lispusers/READ-BDF-old/READ-BDF* --- obsolete/lispusers/READ-BDF-old/READ-BDF | 857 ------------------ .../lispusers/READ-BDF-old/READ-BDF.DFASL | Bin 21485 -> 0 bytes .../lispusers/READ-BDF-old/READ-BDF.TEDIT | Bin 9819 -> 0 bytes 3 files changed, 857 deletions(-) delete mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF delete mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL delete mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF b/obsolete/lispusers/READ-BDF-old/READ-BDF deleted file mode 100644 index a4c28123e..000000000 --- a/obsolete/lispusers/READ-BDF-old/READ-BDF +++ /dev/null @@ -1,857 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" -"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" -"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" -"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10) - -(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101 - - :EDIT-BY "mth" - - :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH - WRITE-BDF-TO-DISPLAYFONT-FILES) - (FILE-ENVIRONMENTS "READ-BDF") - (IL:VARS IL:READ-BDFCOMS) - - :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| -) - - -(IL:PRETTYCOMPRINT IL:READ-BDFCOMS) - -(IL:RPAQQ IL:READ-BDFCOMS - ((IL:STRUCTURES BDF-FONT GLYPH) - (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME - GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING - READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) - (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) - IL:SYSEDIT) - (IL:FILES (IL:LOADCOMP) - IL:FONT)) - (FILE-ENVIRONMENTS "READ-BDF") - (IL:PROP (IL:DATABASE) - IL:READ-BDF))) - -(DEFSTRUCT (BDF-FONT (:CONC-NAME "BF-")) - "Main structure to hold a parsed BDF font file" - (NAME NIL :TYPE STRING) - (SIZE NIL :TYPE LIST) - (BOUNDINGBOX NIL :TYPE LIST) - (METRICSSET 0 :TYPE (INTEGER 0 2)) - (PROPERTIES NIL :TYPE LIST) - SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) - (SLUG NIL :TYPE GLYPH)) - -(DEFSTRUCT GLYPH - "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" - (NAME NIL :TYPE STRING) - ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP - (MCODE 0 :TYPE INTEGER) - (WIDTH 0 :TYPE INTEGER) - (ASCENT 0 :TYPE INTEGER) - (DESCENT 0 :TYPE INTEGER)) - -(DEFCONSTANT MAXCHARSET 255) - -(DEFCONSTANT MAXTHINCHAR 255) - -(DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) - -(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) - (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") - (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") - (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") - (LET (GBCS CSGLYPHS CSLIMITS) - (UNLESS (AND (INTEGERP CSET) - (<= 0 CSET MAXCHARSET)) - (ERROR "Invalid Character set: ~S" CSET) - - (IL:* IL:|;;| "Can we get here? I think not!") - - (SETQ CSET 0)) - (SETQ GBCS (COND - ((LISTP FONT) - - (IL:* IL:|;;| - "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET") - - FONT) - ((BDF-FONT-P FONT) - - (IL:* IL:|;;| - "If passed a BDF-FONT, look only at glyphs in the mapped charsets") - - (FIRST (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE))) - (T (ERROR "Invalid FONT: ~S" FONT)))) - (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS))) - (LET ((TOTAL-WIDTH 0) - (ASCENT 0) - (DESCENT 0) - (FIRSTCHAR MOST-POSITIVE-FIXNUM) - (LASTCHAR MOST-NEGATIVE-FIXNUM) - (CSINFO (IL:|create| CHARSETINFO)) - (DLEFT 0) - SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) - (COND - ((GLYPH-P SLUG-OR-WIDTH) - (SETQ SLUG SLUG-OR-WIDTH) - (SETQ SLUGWIDTH (1+ (GLYPH-WIDTH SLUG))) - (SETQ ASCENT (MAX ASCENT (GLYPH-ASCENT SLUG))) - (SETQ DESCENT (MAX DESCENT (GLYPH-DESCENT SLUG)))) - ((INTEGERP SLUG-OR-WIDTH) - (SETQ SLUGWIDTH SLUG-OR-WIDTH)) - (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH))) - (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL)) - (GL (CDR XGL)) - (GWIDTH (GLYPH-WIDTH - GL)) - (ASC (GLYPH-ASCENT GL)) - (DSC (GLYPH-DESCENT - GL))) - - (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLYPH-DESCENT calculated by READ-GLYPH will not give a useful value, since it is >= 0. Investigate correcting this.") - - (IL:* IL:|;;| -  - "Is the above statement actually true?") - - (SETF (GLYPH-MCODE GL) - MCODE) - (SETQ FIRSTCHAR - (MIN FIRSTCHAR MCODE - )) - (SETQ LASTCHAR - (MAX LASTCHAR MCODE) - ) - (INCF TOTAL-WIDTH GWIDTH) - (SETQ ASCENT - (MAX ASCENT ASC)) - (SETQ DESCENT - (MAX DESCENT DSC)) - GL))) - (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT) - (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT) - (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO)) - - (IL:* IL:|;;| - "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)") - - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I - TOTAL-WIDTH)) - (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) - - (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") - - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I - SLUGWIDTH)) - (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) - - (IL:* IL:|;;| "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ") - - (IL:* IL:|;;| " From \\READSTRIKEFONTFILE, so -ve DESCENT is possible?") - - (SETQ HEIGHT (+ ASCENT DESCENT)) - (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH) - HEIGHT 1)) - (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) - (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM - (GLYPH-BITMAP - GL)) - (SETQ GLW (GLYPH-WIDTH GL)) - (SETQ MCODE (GLYPH-MCODE GL)) - (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) - (+ DESCENT (GLYPH-BBYOFF0 GL)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE) - (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) - (IL:\\FSETOFFSET WIDTHS MCODE GLW) - (INCF DLEFT GLW)) - - (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") - - (IF SLUG - (LET ((GLBM (GLYPH-BITMAP SLUG))) - (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (MAX 0 (GLYPH-BBXOFF0 SLUG))) - (+ DESCENT (GLYPH-BBYOFF0 SLUG)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE)) - (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH) - 0 - (1- SLUGWIDTH) - (+ ASCENT DESCENT) - 'IL:REPLACE)) - CSINFO)))) - -(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") - (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") - (WHEN (AND (BDF-FONT-P BDFONT) - FAMILY) (IL:* IL:\; "FAMILY Cannot be NIL") - (PROG* ((SLUG (BF-SLUG BDFONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - FONTDESC DEV GBCSL CHARSETS) - (WHEN (FONTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY) - (OR SIZE (FONTPROP FAMILY 'IL:SIZE)) - (OR FACE (FONTPROP FAMILY 'IL:FACE)) - (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) - (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE)) - MAP-UNKNOWN-TO-PRIVATE))) - (WHEN (LISTP FAMILY) - - (IL:* IL:|;;| "Assume this is a FONTSPEC") - - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC IL:FSFAMILY) - IL:|of| FAMILY) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) IL:|of| FAMILY) - SIZE) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSFACE) IL:|of| FAMILY) - FACE "MRR") - (OR (IL:|fetch| (IL:FONTSPEC IL:FSROTATION) IL:|of| FAMILY) - ROTATION 0) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) IL:|of| FAMILY) - DEVICE - 'DISPLAY) - MAP-UNKNOWN-TO-PRIVATE))) - (SETQ FAMILY (IL:\\FONTSYMBOL FAMILY)) - (UNLESS (AND (INTEGERP SIZE) - (PLUSP SIZE)) - (ERROR "Invalid SIZE: ~S~%" SIZE)) - (COND - ((NULL ROTATION) - (SETQ ROTATION 0)) - ((NOT (AND (INTEGERP ROTATION) - (>= ROTATION 0))) - (IL:\\ILLEGAL.ARG ROTATION))) - (SETQ DEV DEVICE) - (SETQ DEV (COND - ((NULL DEVICE) - 'DISPLAY) - ((AND (SYMBOLP DEVICE) - (NOT (EQ DEVICE T))) - - (IL:* IL:|;;| - "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.") - - DEVICE) - ((STRINGP DEVICE) - (INTERN (STRING-UPCASE DEVICE) - "IL")) - (T (IL:\\ILLEGAL.ARG DEVICE)))) - (SETQ FACE (IL:\\FONTFACE FACE NIL DEV)) - (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) - (UNLESS SLUGWIDTH - - (IL:* IL:|;;| - "If GLYPHS-BY-CHARSET didn't determine the SLUG width, use 60% of the SIZE, at least 1") - - (SETQ SLUGWIDTH (OR (THIRD GBCSL) - (MAX 1 (ROUND (* 0.6 SIZE)))))) - (FLET ((GBCS-TO-FONTDESC - (GBCS FAMILY) - (LET (FONTDESC CHARSETS) - (WHEN GBCS - (SETQ FONTDESC - (IL:|create| FONTDESCRIPTOR - IL:FONTDEVICE IL:_ DEV - IL:FONTFAMILY IL:_ FAMILY - IL:FONTSIZE IL:_ SIZE - IL:FONTFACE IL:_ FACE - IL:|\\SFAscent| IL:_ 0 - IL:|\\SFDescent| IL:_ 0 - IL:|\\SFHeight| IL:_ 0 - IL:ROTATION IL:_ ROTATION - IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION - DEV))) - (SETQ CHARSETS (LOOP :FOR CS :IN GBCS :WITH CSET :WITH CSINFO :NCONC - (WHEN (<= 0 (SETQ CSET (FIRST CS)) - MAXCHARSET) - (SETQ CSINFO (BDF-TO-CHARSETINFO - GBCS CSET (OR SLUG (1+ - SLUGWIDTH - )))) - (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET - ) - (LIST CSET))))) - (LIST FONTDESC CHARSETS)))) - (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) - FAMILY) - (GBCS-TO-FONTDESC (SECOND GBCSL) - (IL:\\FONTSYMBOL (CONCATENATE 'STRING - (SYMBOL-NAME FAMILY) - "-UNMAPPED"))) - (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) - :TEST - #'EQL))))))))) - -(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") - (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth") - (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) - (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME - PIXEL-SIZE POINT-SIZE) - (SPLIT-FONT-NAME (BF-NAME BDFONT)) (IL:* IL:\; "Parse as XLFD format") - (DECLARE (IGNORE FOUNDRY ADD_STYLE_NAME)) (IL:* IL:\; - "Don't need FOUNDRY or ADD_STYLE_NAME") - (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) - (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) - '((#\R . MEDIUM) - (#\M . MEDIUM) - (#\N . MEDIUM) - (#\B . BOLD) - (#\D . BOLD) - (#\L . LIGHT))))) - 'MEDIUM)) (IL:* IL:\; "DemiBold => BOLD") - (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) - '((REGULAR) - (#\R . REGULAR) - (#\I . ITALIC) - (#\O . ITALIC))))) - 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") - (IL:* IL:\; "Ignore others") - (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) - '((#\R . REGULAR) - (#\N . REGULAR) - (#\B . BOLD) - (#\S . COMPRESSED) - (#\C . COMPRESSED))))) - 'REGULAR)) (IL:* IL:\; - "S is for \"SemiCondensed\", Assuming \"Condensed\"") - - (IL:* IL:|;;| - "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") - - (WHEN (AND (EQ WEIGHT EXPANSION) - (EQ EXPANSION 'BOLD)) - (SETQ EXPANSION 'REGULAR)) - (WHEN (ZEROP (LENGTH PIXEL-SIZE)) - (SETQ PIXEL-SIZE NIL)) - (SETQ POINT-SIZE (COND - ((ZEROP (LENGTH POINT-SIZE)) - NIL) - ((SETQ POINT-SIZE (PARSE-INTEGER POINT-SIZE :JUNK-ALLOWED T)) - (CEILING POINT-SIZE 10)) - (T NIL))) - (LIST FAMILY (LIST WEIGHT SLANT EXPANSION) - (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) - POINT-SIZE - (FIRST (BF-SIZE BDFONT)))))) - -(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") - (IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") - (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") - (LET* ((NCSETS (+ MAXCHARSET 2)) - (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) - (UTOMFN (COND - (RAW-UNICODE-MAPPING #'IDENTITY) - (MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE) - (T #'UTOMCODE?))) - (SLUG (BF-SLUG FONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - NOMAPPINGCSETS ENC MCODE MCS) - (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT - (CONS NIL))))) - (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY) - (TCONC (AREF CSARRAY (LRSH CODE 8)) - (CONS (LOGAND CODE 255) - GLYPH)))) - (LOOP :FOR GL :IN (BF-GLYPHS FONT) - :UNLESS - (EQ GL SLUG) - :DO - (SETQ MCS NIL) - (SETQ ENC (GLYPH-ENCODING GL)) - (WHEN (LISTP ENC) - - (IL:* IL:|;;| - "Should happen only if -1 is first on ENCODING line in BDF file") - - (SETQ ENC (OR (SECOND ENC) - -1)) - - (IL:* IL:|;;| - "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it") - - ) - (SETQ MCODE (AND (INTEGERP ENC) - (PLUSP ENC) - (FUNCALL UTOMFN ENC))) - (IF RAW-UNICODE-MAPPING - (COND - ((> ENC 65535) - (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((AND NIL (= 255 (LOGAND ENC 255))) - - (IL:* IL:|;;| - "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode") - - (WARN - "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR" - (LRSH ENC 8) - (LRSH ENC 8)) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) - (COND - ((AND (ZEROP (GLYPH-BBW GL)) - (ZEROP (FIRST (GLYPH-DWIDTH GL)))) - - (IL:* IL:|;;| - "This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((NULL MCODE) - - (IL:* IL:|;;| "These assoc with the Unicode encoding") - - (COND - ((OR (> ENC 65535) - (= 255 (LOGAND ENC 255))) - - (IL:* IL:|;;| - "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) - ((AND (INTEGERP MCODE) - (<= 0 MCODE 65535)) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset") - - (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) - - (IL:* IL:|;;| "Default SLUG width is width of A.") - - (WHEN (AND (NOT SLUGWIDTH) - (= ENC (CHAR-CODE #\A))) - - (IL:* IL:|;;| "A is the same code in MCCS and UNICODE ") - - (IL:* IL:|;;| - "Comparing with ENC, not MCODE, to look only in charset 0") - - (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) - ((LISTP MCODE) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset (like above)") - - (LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS - (LRSH MC 8)) - MCS) - :DO - (PUSH CS MCS) - (PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS))) - (T (ERROR "Invalid MCODE: ~A~%")))))) - - (IL:* IL:|;;| "Extract the lists from the TCONC pointers") - - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I) - (SORT (REMOVE-DUPLICATES - (CAR (AREF CSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF CSETS I))) - (WHEN CS - (LIST (LIST I CS)))))) - - (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.") - - (WHEN NOMAPPINGCSETS - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO - (SETF (AREF NOMAPPINGCSETS I) - (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF NOMAPPINGCSETS I))) - (WHEN CS - (LIST (LIST I CS))))))) - (LIST CSETS NOMAPPINGCSETS SLUGWIDTH))) - -(DEFMACRO PACKFILENAME.STRING (&WHOLE WHOLE) (IL:* IL:\; "Edited 1-Feb-2025 23:17 by mth") - `(IL:PACKFILENAME.STRING ,@(LOOP :FOR X :IN (CDR WHOLE) - :BY - #'CDDR :AS Y :IN (CDDR WHOLE) - :BY - #'CDDR :NCONC (LIST (COND - ((KEYWORDP X) - (LIST 'QUOTE (INTERN (STRING X) - "IL"))) - ((AND (LISTP X) - (EQ (FIRST X) - 'QUOTE) - (SYMBOLP (CADR X))) - (LIST 'QUOTE (INTERN (STRING (CADR X)) - "IL"))) - (T - (IL:* IL:\; "Hope for the best!") - X)) - Y)))) - -(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") - (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") - (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") - (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") - (LET - (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL (NGLYPHS 0) - (*PACKAGE* (FIND-PACKAGE "BDF"))) - (WITH-OPEN-FILE - (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT) - (LOOP :WHILE (STRING-EQUAL "COMMENT" (SETQ KEY (READ FILE-STREAM))) - :DO - - (IL:* IL:|;;| "Ignore initial COMMENT lines.") - - (READ-LINE FILE-STREAM)) - (UNLESS (STRING-EQUAL "STARTFONT" KEY) - (ERROR "Invalid BDF file - must begin with STARTFONT.")) - - (IL:* IL:|;;| "ignore the file format version number") - - (READ-LINE FILE-STREAM) - (SETQ FONT (MAKE-BDF-FONT)) - (LOOP - :UNTIL FONT-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) - (WHEN LINE (IL:* IL:\; "Ignore blank lines") - (MULTIPLE-VALUE-SETQ (KEY POS) - (READ-FROM-STRING LINE)) - (UNLESS (MEMBER KEY '(COMMENT CONTENTVERSION)) - (WHEN (<= POS (LENGTH LINE)) - (SETQ LINE (SUBSEQ LINE POS))) - (COND - ((EQ KEY 'FONT) - (SETF (BF-NAME FONT) - LINE)) - (T - (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) - (CASE KEY - (METRICSSET (IF (AND (INTEGERP (SETQ V (FIRST ITEMS))) - (<= 0 V 2)) - (SETF (BF-METRICSSET FONT) - V) - (ERROR - "Invalid BDF file - METRICSSET (~A) is invalid or out of range." - V))) - (SIZE (SETF (BF-SIZE FONT) - ITEMS)) - (FONTBOUNDINGBOX (SETF (BF-BOUNDINGBOX FONT) - ITEMS)) - (SWIDTH (SETF (BF-SWIDTH FONT) - ITEMS)) - (DWIDTH (SETF (BF-DWIDTH FONT) - ITEMS)) - (SWIDTH1 (SETF (BF-SWIDTH1 FONT) - ITEMS)) - (DWIDTH1 (SETF (BF-DWIDTH1 FONT) - ITEMS)) - (VVECTOR (SETF (BF-VVECTOR FONT) - ITEMS)) - (STARTPROPERTIES - (IF (AND (INTEGERP (SETQ V (FIRST ITEMS))) - (PLUSP V)) - (SETQ PROPS - (LOOP :UNTIL PROPS-COMPLETE :APPEND - (WITH-INPUT-FROM-STRING - (SI (SETQ LINE (READ-LINE FILE-STREAM))) - - (IL:* IL:|;;| "As of now, COMMENTS not allowed here.") - - (UNLESS (SETQ PROPS-COMPLETE - (STRING-EQUAL "ENDPROPERTIES" - (STRING-TRIM '(#\Space #\Tab) - LINE))) - (SETQ KEY (READ SI)) - (IF (AND KEY (SYMBOLP KEY) - (SETQ VV (READ SI)) - (OR (STRINGP VV) - (INTEGERP VV))) - (LIST (INTERN (STRING KEY) - "KEYWORD") - VV) - (ERROR - "Invalid BDF file - malformed PROPERTY (~A)." - LINE)))))) - (ERROR - "Invalid BDF file - STARTPROPERTIES count (~A) is invalid or missing." - V)) - (IF (EQL V (SETQ VV (/ (LENGTH PROPS) - 2))) - (SETF (BF-PROPERTIES FONT) - PROPS) - (ERROR - "Invalid BDF file - STARTPROPERTIES count (~D) does not match actual (~D)." - V VV))) - (CHARS - (SETQ NGLYPHS (FIRST ITEMS)) - (UNLESS (AND NGLYPHS (INTEGERP NGLYPHS) - (PLUSP NGLYPHS)) - (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." - NGLYPHS)) - (SETF (BF-GLYPHS FONT) - (LOOP :REPEAT NGLYPHS :COLLECT - (PROG1 (SETQ GL (READ-GLYPH FILE-STREAM FONT)) - - (IL:* IL:|;;| - "Any GLYPH with ENCODING of -1 is taken as the SLUG glyph. If multiple, the last applies.") - - (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - (WHEN (EQ V -1) - (SETF (BF-SLUG FONT) - GL)))))) - (ENDFONT (SETQ FONT-COMPLETE T)))))))) - (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) - SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) - (WHEN VERBOSE - (FORMAT *STANDARD-OUTPUT* - "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" - (BF-NAME FONT) - FAMILY SIZE WEIGHT SLANT EXPANSION)) - (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE))))) - -(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) - (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") - (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT))) - (READ-DELIMITED-LIST DELIMIT SI))) - -(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth") - (IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth") - (IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth") - (IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth") - (LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT)) - :DWIDTH - (COPY-LIST (BF-DWIDTH FONT)) - :SWIDTH1 - (COPY-LIST (BF-SWIDTH1 FONT)) - :DWIDTH1 - (COPY-LIST (BF-DWIDTH1 FONT)) - :VVECTOR - (COPY-LIST (BF-VVECTOR FONT)))) - CHAR-COMPLETE LINE ITEMS V KEY POS STARTED BBW BBH) - (LOOP :UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) - (WHEN LINE (IL:* IL:\; "Ignore blank lines") - (MULTIPLE-VALUE-SETQ (KEY POS) - (READ-FROM-STRING LINE)) - (WHEN (<= POS (LENGTH LINE)) - (SETQ LINE (SUBSEQ LINE POS))) - (COND - ((EQ KEY 'COMMENT) (IL:* IL:\; "Ignore COMMENT lines") - (IL:* IL:\; - "Probably aren't \"legal\" here, anyway.") - ) - ((EQ KEY 'STARTCHAR) - (WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph.")) - (SETF STARTED T) - (SETF (GLYPH-NAME GLYPH) - (STRING LINE))) - (T (UNLESS STARTED (ERROR - "Invalid BDF file - glyph has not been started. STARTCHAR missing." - )) - (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) - (CASE KEY - (ENCODING (SETF (GLYPH-ENCODING GLYPH) - (IF (EQUAL -1 (FIRST ITEMS)) - ITEMS - (FIRST ITEMS)))) - (SWIDTH (SETF (GLYPH-SWIDTH GLYPH) - ITEMS)) - (DWIDTH (SETF (GLYPH-DWIDTH GLYPH) - ITEMS)) - (SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH) - ITEMS)) - (DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH) - ITEMS)) - (VVECTOR (SETF (GLYPH-VVECTOR GLYPH) - ITEMS)) - (BBX (SETF (GLYPH-BBW GLYPH) - (SETQ BBW (FIRST ITEMS)) - (GLYPH-BBH GLYPH) - (SETQ BBH (SECOND ITEMS)) - (GLYPH-BBXOFF0 GLYPH) - (THIRD ITEMS) - (GLYPH-BBYOFF0 GLYPH) - (FOURTH ITEMS))) - (BITMAP (LET* ((BM (BITMAPCREATE BBW BBH 1)) - (BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM)) - (BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH - IL:|of| BM)) - (NBYTES (CEILING BBW 8)) - (NCHARS (* 2 NBYTES)) - (NWORDS (CEILING BBW 16)) - BITS BYTEPOS WORDINDEX) - (LOOP :WITH BITROW = 0 :REPEAT BBH :DO - (SETQ LINE (STRING-TRIM '(#\Space #\Tab) - (READ-LINE FILE-STREAM))) - (UNLESS (AND (EQUAL NCHARS (LENGTH LINE)) - (SETQ BITS - (PARSE-INTEGER LINE :RADIX 16 - :JUNK-ALLOWED T))) - (ERROR - "Invalid BDF file - bad line in BITMAP: ~A" - LINE)) - (WHEN (ODDP NBYTES) - (SETQ BITS (ASH BITS 8))) - (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) - (SETQ BYTEPOS (* 16 (1- NWORDS))) - (LOOP :REPEAT NWORDS :DO - (IL:\\PUTBASE BM.BASE WORDINDEX - (LDB (BYTE 16 BYTEPOS) - BITS)) - (INCF WORDINDEX) - (DECF BYTEPOS 16)) - (INCF BITROW)) - (SETF (GLYPH-BITMAP GLYPH) - BM))) - (ENDCHAR (SETQ CHAR-COMPLETE T))))))) - (SETF (GLYPH-ASCENT GLYPH) - (+ (GLYPH-BBH GLYPH) - (GLYPH-BBYOFF0 GLYPH))) - (SETF (GLYPH-DESCENT GLYPH) - (ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH)))) - (SETF (GLYPH-WIDTH GLYPH) - (MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH)) - (GLYPH-BBW GLYPH)) - (FIRST (GLYPH-DWIDTH GLYPH)))) - GLYPH)) - -(DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth") - (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") - - (IL:* IL:|;;| "First, check if it COULD be in XLFD format") - - (COND - ((POSITION #\- NAME :TEST #'CHAR=) - (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) - 1 - 0) - THEN - (1+ J) - :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=) - :COLLECT - (SUBSEQ NAME I J) - :WHILE J)) - (T - (IL:* IL:|;;| "Return the NAME as FAMILY with a NIL FOUNDRY") - - (LIST NIL NAME)))) - -(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE - (CHAR-SETS T) - MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED - RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth") - (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") - (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") - (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) - (COND - ((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets") - ) - ((NULL CHAR-SETS) - (SETQ CHAR-SETS '(0)) (IL:* IL:\; "Only charset 0") - ) - ((AND (INTEGERP CHAR-SETS) - (<= 0 CHAR-SETS MAXCHARSET)) (IL:* IL:\; "A single integer charset") - (SETQ CHAR-SETS (LIST CHAR-SETS))) - ((AND (LISTP CHAR-SETS) - (EVERY #'(LAMBDA (CS) - (AND (INTEGERP CS) - (<= 0 CS MAXCHARSET))) - CHAR-SETS))) - (T (ERROR "Invalid specification of :CHAR-SETS ~S~%" CHAR-SETS))) - (DESTRUCTURING-BIND (FN-FAMILY FN-FACE FN-SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) - (SETQ FAMILY (OR FAMILY FN-FAMILY)) - (WHEN RAW-UNICODE-MAPPING - (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) - (SETQ FACE (OR FACE FN-FACE)) - (SETQ SIZE (OR SIZE FN-SIZE)) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) - (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (UNLESS (EQ CHAR-SETS T) - (SETQ CSETS (INTERSECTION CHAR-SETS CSETS)) - (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) - (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS - (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME FAMILY SIZE FACE - "DISPLAYFONT" CS)))) - (IF WRITE-UNMAPPED - (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE - UNMAPPED-FONTDESC CS - (PACKFILENAME.STRING - :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME (FONTPROP - UNMAPPED-FONTDESC - 'IL:FAMILY) - SIZE FACE "DISPLAYFONT" CS)))) - (SETQ UNICODE-CSETS NIL)) - - (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") - - (IL:* IL:|;;| - "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)") - - (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) -(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY - -(IL:FILESLOAD (IL:SYSLOAD) - IL:SYSEDIT) - - -(IL:FILESLOAD (IL:LOADCOMP) - IL:FONT) -) - -(DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") - (:EXPORT "READ-BDF" - "WRITE-BDF-TO-DISPLAYFONT-FILES") - (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" - "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" - "BLTSHADE" "BOLD" "COMPRESSED" - "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" - "FONTP" "FONTPROP" "INPUT" "ITALIC" - "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" - "UTOMCODE" "UTOMCODE?" - "WRITESTRIKEFONTFILE")) - :READTABLE "XCL" - :COMPILER :COMPILE-FILE) - -(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) -(IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR -10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 ( -GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 ( -READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 ( -READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827))))) -IL:STOP diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL b/obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL deleted file mode 100644 index 927778eaf9838aafa5ba0d1b7cc9d57d42e6156d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 21485 zcmd^ndwko~mFMsGll+M72*pv1V~kOq;08A`36Bs`3i?@+BUz81k>n(%0iz@?lC3zI zIH9Evuz|D%M8FOK{UB**r?2VE?AY$mCXN$L+v&qlraVH+%xt%v?Y2z2(`jb2Tc)Mp z{ho90Pm)8@=V$-gJao@J=iK+b=bn4+xxaCxdW$dO_U+oaJChyQTmKT{{PE+?m?D_r}oh-hn;Y%*gH=cMj~x4%~Gk!TUxA z_Ke&Z59oeRr@yP?-D|I|NtETWea}E@@4ybXdz~k?>rT&AYp%N1ebv<))~?xb?b@0y zJrNN_S!~JlzC9y5Qg^L(uXBTcVCObej}omerJ6sIe_UI!OTnKzia)gkEm@*6dJ#pO zil*id;^?fIN@t$XjT-Ja~goda3w zh@Bd;$UmB^?&^*Ck|86OKd6psmm))_KhPD51w525l6M(SBq_*Bf0C9|4K4)hlqbmbjdW?87pR2ZpAfId591kS}G#s9!;qfD*h~C#_#FAX+ zME>A%UMog}fzZYvsI`K+Ipj|U^SPSN z2-=hg>V8zO8p$PS?=&KQkkOo;cp#AoAX4iK>hVM%NxhcORmqy=F-EAIKalXnLp@0& zp3hYf0?n`HFm3>>;E_TlLrFan@&OSM)v-t73Dl!98t{jD(UhuqU}JAYr(BXgBL>du z-lP%r8C1bV7I;%Wx0Jgnk&K7J0V;kLkoyXChazG1Au)G;hiuv{R0o z^mvHcM(j0FeTy6s&?j=Wh$n-g7~vSkHUO>*Y|C zyY7z^`n)9kyd*MZ%YhLb=bvmNBNkWCGANW55JS9xoJu}d54kAjwcDD|rDbEg(Y*c& z^uZ;U7pJ~QcD;w1ne6Kc(DbiF$0h^OItXVMM2@G2B#)m)U#yqP>p@vY+#ZNf>;@&$ zHIM>}%P4{Pm8N$E?Hk3^9;34xqP^bqs;1Z0oIhAcqvlm;7<-IREE$M1LNo8=&@RJD z>U)eOL};RlDb(t2 zAi?p<1n&j{_Ltx)fnUpnDnXEuO`FhvhLAIrVyQEiJrU`p1^ozCjU3L=QIcj|9!y>H zUd)6Cs0P-|@bobAa?BaMHvk=b=w$- zE83{}VX7h$Ea+s(f1sG{M>N8d8W9j4frH*BemoPKw6ZfTNGABxy+4RZ# zQnQ(p7N%nG)L8126{}76I|}K3XW?Th02u&flzLEHM5zbGRZeLDrI9ENpfr|Knm}nL zN)sr}<&+js+(c;s#a&Km1!W~sT0vP^PH6*W6;awiSyfJH2W2%;+Cf=exSdAhvi^=j z=#bG7bSZ@}!fuyVh$4)*>;Vn}SsNPjmFd7MJaMcxzW`der zj)LJPsKwzpZz@ zzP*%#=Y&Lm)|$kJ#Uxhl^&S&Ta(uEW!&5HEziFX5Y*Px8Ke!#`DVJ^W&M6qrpm$Eg za3Zi{G=tt}E30Tc5wFHzBB;SgBB;YKB5+^~5jZh`2H<+v zRIt@1?BW;sf&pLH!rwtENs`kCRjwT@fmYE|nc!Dm!|m#7h-Nmnx1fRUBQaIJ#7EbgAO#QpM4s z;&A?rGHjAzvkY5U1w!iI{+HAs?zNAbI&Dy_260PilXEiZK@h3~F&q;4IKj9_`1eu% z9p~Q({yhj@TW9BHq-KB)SF~MqZZW#L)>x6gVuX&>I7Ts{g3qA>EU8JAdcub>7fI=; z#1Ss+2~vKBK<-w=Rd8D z{3qaW2#!*xSedc1L5ux0aMcN}^XeSL^RFeI3#uMJ1<&I0e9otR{H(-uVFl!WmYCkA zgZ#>B+`oZoktj}#qU@w!TMR!hXW*l==*2fIhJP;=QyO)d%Wo{EUz9Uhvq3VwX)&Dv zlkCFcERj5K31#FnV$A*njJ2ZD))bO_^9%U?SBcM>UxE*UjOT#N?`)~y;^dQz>H^09 z4MsUQ#hHmI*_TXbM%?(98g^%fcVzC&?AVvevKn?r_O9LO4tHpHdv@QBff1M#cMiDk zOl9{0-k!>C-2gAS zsVDWt3H7DEoZ=4rJUjhrIjddP+H3=D?w=^ z%1Th$$|lKR#{P&27-tpvGA zeQP6VC8=-i1g#?Vt%IP|q`s{;*0>rexXRT;!8NXC3f8$=5J(;2^-CA3c4F?#@eFzv zN>*uKp~?0g#=pS7FY@n8{QELEX;%?J5P`L$2#_TRK)IU$5_<^&ywZs#mNK9!xmJ}W zC{rDv#csE;_$VoMYJv(@H_(sH;PnJv$>4edFJd_gFJ-(f{iUAs^bR4b(-c=%6M1m`L-FQC=^acZD< zt`XypfI_`X*C3Tr$j-CbSy-Uu4M;xM0Obx=aJuhEx=Z$6N+EPS ztqD42H4YW9UWTGoB<)ELwbJyMwc16dU&X&=be@KqWRc9>rvLY?#>MAU!!k3M*MoXY z-B`sz5QPR*{G&n{6EXu_m@vD`HV>=H`5N6^UfQ`f?6M*+Sy-gg>{9U$)^)4ME}X4H zVkX+2rQ@`IwR=1>njTM&W^S42o^%cBXUEeY)3fskMlZ~*;0LMOJ4?0nYt>d>qIoyVPt*fk6XM4<+u2*g4LNI)ksIC0cfh`~`91QYE! zbfl*ph7RzwpU`o=ldU7u;m-d0N~*wI)6i+Kg|U|y64Q(w#Aq?xXD5u7F~fZ#LUBoJ zAwIX!0-AfwXqlb7q*HX`W1Yz5A#Pcx=&*FUslNqDL)eVy&~LPIizcR&`;1nV5N>0o ziv7q~sr9dtmBA)tNVpkWj|I123z9HS<&A}?(e~!q@#vV*b~0wPogI$>I@N8opYC5X z6E;?#9S@Hgt4~CXjW3Ae9~n!8Z9q$KaU=6L5H;zCSQ}O<`nd5IqNc`8LWn@jQ1y!7aNwn5RRP2 zSach%(?-(}8_F?67DEFhTnO2d{e(J=wshLOjTWo(Oru5ZcZ=?7;9j)4t`$8h;70D% z!9k+|(?a6vvBwV@tIm!Ojv1>?M=UgIv68cv0dMR4vserx8s7GT;iT3y6VytO(`Y^2 zzltVji-y`x&2Ka6r<2wsY3O%T+1*yW9xQ{HGgNd7ik5Q;MY~1OB6wTTlPy>l$Y<#E zpy3*N1sx|URz(vRUFJ+<+YT*P6uY#!+E^}aC9r|PTM4{~!P@|8e@oV*K+NAm5z1k~jV+Ms`0ypQx+(O#!Af5^)YX2^Re-gnzh~TRtc#P^2`j;X&DuRO|xJCqxBB+qXsdax?jx{)R`ph@Nunw6aemYc!h8alx~-u|B(PDBbm;MognR#KJd3t+%xELqw zeqgHvmgK7XUat0s2wcZtia<8Ns&^7-H@guipBBLp6kPOIA^ZVObkB!GkQPC&2sVOQ zIJwk=m!5D#gkmTS{^Z_c+8n!zT;i24401Ykq49LM=W9pZg z-X*5D0_n6mxWQoDXv6}3Ak^>Of75dFNrEQW6NsP=T*F(Ei*h63bob?;D6ir&HX4ts z2bf{dWS=c{G7NQO0%!wzjLazaNUEH|uUjw0(0XGkslbK^XN@={5Ut(U`BYGl95n2RGw}$9I7m1YZOhkLx z3{h}|XH5TxIoPJwAjLAf%_>*8Sn)>#x`PT`DQ4E=`3_%vp4^G~*vmUWb}0Gm+`* zvQ?2m9xmR$UWS^RO&Lu*5KY++vT#3SG-chdj2TTYa#ojU=Sfe5eQ3u0M)pG2u0{7grt+Ym*)lxh;2wy3E!)Y$skdZ zOgRit`4uR(K!hjhG^3B~6v6G3CLV|yn*#3zc##zAmSbhJd9#BVQx{Q|Uo^cGE-|;e?l5W_sZRK#NjsC9ki?v;%RG8-cMB*va6h2%CVD zUYQRhFunyCD*T_xIZrsZsGmG1*AVI@T^^CvD8?w=J>fSks9q<%w9SnK7Zf z2VyAKvH%$_?x^v}od!wtAN4mHj!VZUm*ar%Xrk_FSWpZEKK1)^+%`^Gn7o?%q`zUp zX!vM$KAN5X@%+(qn)5JvBvR@Tj2gyi>aDGVG*tEIKMZgp2plX`xSKcXza-{iX&Uj2 zD@7S9MR~93cVW|R_%iZcVvK|G2u5KeW2D!AMx{50S+7(D)7xZctUAVEyx z@WD*t98Xzl$GKvEN8sNwNDP`VUN9(36JH_h<0Xa!M7wYWCxW=%U{(JAFi$_Q>irCU zl|a5wR~cMGZP={G>Cm8jyU49P1H5n}(BpBvkEl-*D_O=3W;-gx>``%WIC=#m|DG=e z)UP)nf$cUVu=#Y_l5FGzWP>jd!3OZ^4Fq`sRRnJC)#;>TdpBqCS%BK#F!&7uzrf%( z34EHtZxJ}o;2eQD1}T|3Cu|(TKBI0GHjbZ&V3v1XDoeO+cqr&m7VyShA;9G0#DLS7bRFJN?yRCOP zvwhc&0r$W#0=fsrh4Qw6yLJulaIanG-j>-rf)v+ofvt`j@B-y|JM_~fo!%dP$qPxM z3!zF1b`w15h4TZn8Ovkb!{dYD5!Y7-Sj)Cynv2%};;sfy27C!-l!v>oB0;G@F=*c_ zBA}sAWy%m@qy64tXiiN7AK0B5-T`mp^Es*Wxk!1A1rzU~UJVX;UQNSx*DZG>vsNZLmDZwgCsV&q;Ac61TKvi*41Sov z{RApUx&_87Vpr27#2VUc#Qi-hnbd!=2<#uBm2`8jkql%Q^Mef{pd;-0-V@N|RUYKC zFiazO8^bqGZQOVKBX;&uoI8^DAexGF{lq=sKF>5j&eqMF+q|A0Q!FKaP#93S%jCNX zI~hubA{6gC40=a0o>$mVaEOnjdDvp^lR_838r^ zwexQ!{}zpdpw=-4KAwP~8{rpMK=_3UfM1+b@GDPnJPDSls<+hc5+r=gzzn}m{5BV; z4%{s+CFs(I7z}#&Q5G!f?bI`P2-R-Jw9@3EmD!^wgFHIefT}hH;+;k!pzSj&H>1gQ zczEUKwS}biT@Y5n`aEb>4}e_K^KS>KE)WTjCms9e*{EM06a8afB`P!5#4RENYF&Xx z^wH4=gA!Yq{I8O$j!9qO7$<-gQlu@A91dZvu&Q3vcXzeWAUDajj|qbE}3%zC-?Q4>7_74u%ZkWjPR89GbwGC1etS^)Qx^2W_sjcY8> zuFy9TnrsfvHHt|<7}(`uIB#5NIByh#ZA}K*4UMxAK3)xXqX$4MR;{6MGC0>DPHdW( zWt8=8<1tJY2X8@708n?%!v=B`kfwr$qZ3a^#6dV>6^5K3YNBm3k)c;+Cm#uEn8=S5 zn{DATQ*8)QF;)iS5x@)ULyqkb{3S};|2 zbKG#PR4X}Kl6bh5^*Rb1bt<-6NR=g}$D-nCXFK+JXM1mKGYcaaVDXTp-P~QP!q5US zqY5np#uoT-C-L&ovv%#(*ENG;Z$);scpBClNbrL+!YzfMui6^jL~lzFx6Om6l6Fp= zqq8R6&_VknleD}IB;{3mmdj$0bWiQ_D+y~dmJBl5!zG4&46+VA2;N2PC@Kro{J=D_ zPpq_v^FvE|M-$Mal+ij$!Y}1u5()sL3U!vsR$ej<3jP8-m5JWYMBrwM^2-YKuqgM9 z-5@$S1AgHrin)#Iq$wc^lm~nwCidmjl}NBOfd{I1EgwC8 z!5XaXFEBV&xEUpLC%doPa)Qv!imnZIa4Pq^U}NJB-Y-#niqYz?fW8Q()i^)Ov>rHt zLH$?3@O`c>^`!c3f%yt!CI~YrFnl0U#tHM7z&yY_j}qns0>h>;S8`E>uD_v8<=%CkuHTu;((`#d$&wFM`gl^%Xenb*>7zz1)kjx!b>9J=8 zU8n?9J1K{HC+rUj<*2?RpTqYH#ASWi+$}x1JKxmBcM;sX-sj$v8opzI8;~Q_8v+If zT~aOCVc#Lo$(Pz{_Ps-UU~tBUTc!Q)+~FC2l3)_yNa>PafeBHH7N?- z%hTf@KKk$hOItz5qZ;dmZ|%Cnrhx)RNGUot0K4Y^bjbXWR96ZEL;pB<=JQ!Cg_)@o z9uO0jK(39~n!r54*&f#?l_>B-iQ@Tup)-SNXbW9zaZso$Zc}tmK|@Rj2KnII9%0P9 zpM&>{HxftcF?0@`srZ47hdpA<-Qu!9Ibt6|!3!kH7#K@R&o_S8`wBI>m*X47n`<(}F)wVMK3SRr# z%EM+4azzd{VP@Bbl2*g*;lYrYy0>8*Z^Hfv*dIK!wPlgR0J%aU-zOpngE4KT^{^V>5S(^PtaW;ZsxU8gk{7 zet#}zg9jnquQL2Cay-PXwb0J#0#!4bzDw7Dj;xdCa?v?ZcvTLPtDh6Tea0$i_b@a4 zJ@>O1GfpsLG>h*1HXD}O4;t;0&Eg6-E3P&(;>6$YCWfateK#k?)n?PskI#J0aA&Ju zBL~Vhqw%}&Im|lY1^LQ%;hSi*kjG{_A1v0v$iDIg&{{dM;pTwc1y{nnzM6a$TeHqr z03lsFu65eU;@$>YJ2hezFstB7c)jR6IQ%yh9+3Suo;g1C=3YS%zjIC*x=xcHH+Pmd>NM9?Mzw+LJ! zz{4C$CtUY5(%?z|r;A&m+W(yC+7>S3X{s6B=T^jZe`pJ0>W{F?$ww6w#9)g z-z0F7Gg1Fs1cyX`_k={Fr}cQbfiERcY>z+=QgI3&6hu?hUdHf2At-o+<&qByR}0L$ zn1>GvEdtZP7(OT{j8R@^%zsk$FAB_YR6r;Y#a1hSMO@mYhUpb2te4+odavV@FTKn3 zUe3^q%S|u8zEEDMGQGTgDBmI7P8))C{yZwow$u)HHZwc`_1-O>tI^?r61+>Qb5yJU zkIA098hq3ARe4y zGTw}h?*l@V@qWTTynC?5F}<0M?zCkICgJOG2L5-0GiAxnbyZo+Qs6|$+Z|?=s_l6A z(b4_kq0=*y&jmGS+6xUGYy4(-+?Ban@T=}ham-bdSisdiMgli0Moion9QDv3s7H8& zwdfL#9j)NuQa>Zs$!Bk*smcu&%EV{H^N7#d)*tY+9q_0JJZN@Y?DyKxz|dJ}VDfDQ zH@?O8Ohx+GSn60Qc6=-)KL|jynX%MNiFRTvB|i;7wAr!LY>}2ZIhK+i2_RbOBLOyi zXaKhcc&TN*U}KDvFiz>Ty1lP2g_rvzkxiFj0SAHkjUdfh~{H(`4RUa zoFd2*g$J0SW8LH3V@BglXgmbZqvPISs5?xaIKqC!Ed9+Yc2=WV>vyZPKe@I3(&Ge` zpCzEY)djTpi;Ypa#ep$uwDUGc9IbezkjB$Eql2>?pWI+{s1$E8)^O+R{EO1Lmc|;f z@A8D^$|9wPJSP9na7=G8+L4qV;TdaWb|GVpO7S+Mqbxf^TxM`BteiXEp7RBV7AAXFI36lRao>f#kY{~wIzK0jK$0x=CE``GtP?``tA0@C2X;@HE#7&V-!{3L9+y_Z9P+#PxZnO6JrvGcX6X#5`4T{KwVul7mc`!YPUXJ)a+NCmBkqY6^cA^x z@uK7(Uf*I#myirGk}B7Vn?=}Q#kU8`?o-{Ze7?l_y_IUfcd?_|<>vKH^ZE)m7Dk=4 zAaF|h)?77dpyUPGVBSEVnsbo__}tHmspbtTJ{V><*TOh}FAtiF;Pqx=rOVF}ny?5i z{34-QU;Z7k-{VV!W&>ZalJNNd{^Nsu%PejLS$NZkzwNt}rSZiZS&XCnfM7y_LpDCf Saf3MktQIpAJ{269pZ~w)MlIO@ diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT b/obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT deleted file mode 100644 index 891c14cc161b6a178923a02d5d7af4e2a55e0467..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 9819 zcmeHN%W~V+8K!(mD>`j@$@G>^d+KBoaw@TsY|D;j(kV?r5^9QMK+v|@=>j4_5itlb z0BBoTca@juzKhOu+b75q^a--)uG1$-zwZamA!$*P-FlHl=$Hil^Pm5IJI6Wn2cdtu z>R9#N_4~Vf<*jo0cDcM+E*l7*0l9y=qYk|+QwRQVn8cB)jPi%ydEs;%1+~5xW`2KE z^9R#v*&PL`8pQqS*pD(5dTFNoL6G?ag`M?D5`=1NdrfU^Y~87q?Uw7bcY6)jZnyHC z<9IL)eKqihLFA`uIF0&Q5J#!XVwL#bKtWP9jFYjK;RhUsLFlJz%8Ldn8~G9Oo+aR? zcI|GbSwGrqx7-{_^?~mNQ4pOFRh@*VlMz@X@mSu|c$)P6oB@c|lpU#voI*8C{WapG z%g8hkzVvi_9EYh2pd)QuSjtQM9F$8w@%m4^69`}4>$SwL-Esvs+tE%{ow|FV-fwqk z^LkS~w4D3xu2o(A<6dFwKb05oY4ud>JMoefKB02r1sF-C6Tcq}1ITxLDx_@sLA4=#G&EgIS1*2Z|h!5Un)gF!YfkPkmCpkS4WC0)()L&fM9n zH>{fK`Z>sU4%OD(+UC}p+QTZ63V8+{6W}KhC+#P}ghr`V^N@Pv*sjIWvF^6l=hAI` z&u&^>wTcxc->%hlvFxb#A6Q4=d1yC}RM-B4CH$4scI%8q;61b(mTDZ-o%OEecGY3M zv)*exXtf`;$f4ud59_X_a<;t|mOIw2a_WzOWjETp);d9UYrnd>`eHa=BCC{)bV<#S z>QE>`bNF6=q#iR@`y(&$`tXrT{Y*U@1z0FzF4eWACGXJgfRyWJadJxH#`4I`MRB9)_}EX3 zKny;EtfiYI@zY@74{GJyX9!g|4Z(q^Su<|SBe(F~Odi%@##xGdP+oE(?Lexy-Q1xO z8b~S^(Fc?4T;?1WSTrDiJVD;Y>IC-Ib)?8JQ^bQPZw{;~Mc$KxsU0X!I^O3Zn#L*$ zp^B&3WSSAejXL$A=5hR#m8l5ev3E)rdMXUyOkfw1AafZf3tFP8L^?t|B;b1!EPvB>xRl$?2YV!hkVH%4Rk!A=lHXOU-wjD@(f^MhI6-c^BpYqUAh4?zu(D6_> zhbWL{#fMz8a?jEbPZ2jutz4dEvEG6(&U0iwZ%|~wWP%{Zw6LbqQ9KO?c{8O@vv^{= zoGUR!M=ufrRb5(+A7E1gpQJ!Xb6OVjs=|VO0yMGi1_NsA&YddEWn8&zA0$QM`kssr z>^2KXScO5*NeoIHv3Jkwsy6bR)}f2`-2IDQ{3W6=%W-g;dwXBAY=; z3I}!IJaJBRi_`fET z>LuMn50OL6NV=9)IEv2leQv3m=V(#BXVsMUr7lGl%uJ2ukL2f)ZUl>KxfaXpmrW5! zh{e3A=QPgcJB?m~Go?5O@zuo8s;~p@>^F}(2MGT(^P)bYPLDdQ)U+cqHkS>fWPTdJ zfsoT^UO$R)Jl`e9B=i&=wX=f6sM7@pxmX;=Oe__p{kLl4`5r#3wvuOXA}ZwZDGJd? zvWEDDh(0F9oo%67HTl4l>Au<}k+T36)iFu`J<$Dp+X2 zS{wODK&l%^|%B{9*b<1CURr>evtJ10qzc9JYNg#U`qq1a}(k3xXFgxaAt}2e> zBG<*C4OKZRfVeapeL(b|PvV3pMl(JzHH(8G_P{hTHYGS$VLRC8#}_D)jc}^gCrBfG zkKGjZD{_^J03H`XoN5+f;0`FznTg;q*Be2QP%1Gyodd z4BC3YrY_91i@hy#9!xSEVi1D@q8-Ovc#U6-ba|W8RE9d1E=V{Rr8taP4UCAk)h+B= z)a4lWIGH+y&5Hp`95;#6G&n|s3h{vS$7G7D3FJV6AqDfJgmr$AQG^ssjUEZ79mP}R z`YDI5oa_W~7xT1ix9t30rmDQbAYU|=ndz3FBF+^*FS@WF?hPm*{aoDHh?jATBt1&I z8JKxg6iPB~W)9m!sOmPxTL5!igerqG3`ondi3ZKDm(L;u7j=3cKbnBRX*<3cU8k`xt3$?R^@7- zSn2l2T8=s(WVasLUHg91Qf>5xuGK_%cOZx>?;Tt*0D!v!S>?^c=7uh3hqyOzTB?oX zU(;?C1YE~{V6}Vs_FfAZX3cusskgekuW+pWUbF6~ZnNF7%-bW&-al~Fp|xxG4k?)B zXwJQ^<%n@;(XM+0aq)x`W!pK#706k$!7!V5Z>w9|YU|!T{8V%N$^m)=jG3FOcyW&? zM6cDt0zue&@3y*o`?k8XHNV%j9=ozp+zONrx7F=C+iH6Q&ZRh2?5sCo@fI&zh$Wc+ zUjTsSHxB2F;6b^-{UCDNn`M)s@nF^Y6=^?*RDb$`_??;dkZg zwbFYlcwK_H;?4n=ZJJv)k7qWO7C5bZaVe+Ur1cV;3`;!R#osT@9@yYY=}XX9#%q3? zm=4>%58$<{S1&i+X6f_N=PUPw#x3*Z1qdcnNF} zdlllZi2l7-qkiSp(Bbk=O9vHnZ`+lBcWN~2-7cn$N-;BFh&Xf{4n?L*cG_LHm`d17 zRi%TY7oVyxXRNIBU>U;$tNGA!?M9u0%j@QOxsv#|o7bk~OIh`GGDN_>N(f#pm9|Q& z#^5jKwi$yrnLigM&_Wb4=`Tjd@~u+YwGXYX(>|=Xih^=cih=__S44K<@D^UB(tQ^X zt6YSd_~a;8uy*6X={2p|zUA(Dz+(I*`a)_>s3nwMMp2LYrh8y@n35Yd<5w>3mIl0;QQG^>?&G(^PV*UvSCDo`3}P~5;4 zC(;ToA-~cPF#x|rVrujwE-gSr^99HcHIA5#1Z6wDDb^P$3wPWkF17k4AE=Q8E;lsJ zK#Y-%Em|6f#D&ezG(@NuX^pk)D~hoB z6>&8bSrHVjXh_N6iUBFj-|%-~w*&!q8;59)#u6qZwT)N)qp66iNZ06OY;#}ZkREr6 ztz{Viiizj^;U^kZ@{Ht+sei#G?*1_!xXYO6{WB1;xi-xLhfL#&oD{;-5Uo_{0}U}s zi5-{HGp05Yi*^h0N$?Y54Ebx#!MNkE8e+7XXoxnBw$h3Ss-?LCG#Uz*K^2(>aUIl_ lONW~LuSz&x$b7g1ly`S=Q?T>NKmYY-`04G^-#`1ue*uQ5HM#%* From 71894e9b542f07796d0c8c803d404a2b17594811 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 8 Dec 2025 12:18:35 -0800 Subject: [PATCH 9/9] Make CHARSETENCODING and FONTCHARENCODING values of CHARSETINFO and FONTDESCRIPTOR, respectively, explicitly be MCCS --- lispusers/READ-BDF | 45 ++++++++++++++++++++++----------------- lispusers/READ-BDF.DFASL | Bin 24636 -> 24873 bytes 2 files changed, 25 insertions(+), 20 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 062419e45..3a1d3bdfa 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,17 +1,18 @@ (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" "BUILD-COMPOSITE" "WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE") (IMPORT-FROM "IL" "BITBLT" "BITMAPBIT" "BITMAPCREATE" -"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" -"FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" -"UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10) +"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "CHARSETPROP" +"DISPLAY" "FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MCCS" "MEDIUM" +"REGULAR" "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE +10) -(IL:FILECREATED " 2-Dec-2025 16:10:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;6| 50944 +(IL:FILECREATED " 8-Dec-2025 12:13:40" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| 51309 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE - BUILD-COMPOSITE READ-BDF) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR) + (FILE-ENVIRONMENTS "READ-BDF") - :PREVIOUS-DATE "30-Nov-2025 17:43:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;1| + :PREVIOUS-DATE " 8-Dec-2025 12:12:47" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;8| ) @@ -76,7 +77,8 @@ (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) -(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUGWIDTH) (IL:* IL:\; "Edited 30-Nov-2025 00:12 by mth") +(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUGWIDTH) (IL:* IL:\; "Edited 8-Dec-2025 12:13 by mth") + (IL:* IL:\; "Edited 30-Nov-2025 00:12 by mth") (IL:* IL:\; "Edited 28-Nov-2025 16:37 by mth") (IL:* IL:\; "Edited 26-Nov-2025 21:18 by mth") (IL:* IL:\; "Edited 20-Nov-2025 12:19 by mth") @@ -124,6 +126,7 @@ (IMAGEWIDTHS (IL:\\CREATECSINFOELEMENT)) (DLEFT 0) GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) + (CHARSETPROP CSINFO 'IL:CSCHARENCODING 'MCCS) (LOOP :FOR XGL :IN CSGLYPHS :DO (LET* ((MCODE (CAR XGL)) (GL (CDR XGL)) (GWIDTH (GLYPH-WIDTH GL)) @@ -199,6 +202,7 @@ CSINFO)))) (DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE) + (IL:* IL:\; "Edited 8-Dec-2025 12:11 by mth") (IL:* IL:\; "Edited 2-Dec-2025 16:10 by mth") (IL:* IL:\; "Edited 30-Nov-2025 15:59 by mth") (IL:* IL:\; "Edited 28-Nov-2025 18:03 by mth") @@ -295,7 +299,8 @@ IL:|\\SFHeight| IL:_ 0 IL:ROTATION IL:_ ROTATION IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION DEVICE) - IL:FONTSLUGWIDTH IL:_ SLUGWIDTH)) + IL:FONTSLUGWIDTH IL:_ SLUGWIDTH + IL:FONTCHARENCODING IL:_ 'MCCS)) (SETQ CHARSETS (LOOP :FOR CS :IN GBCSL :WITH CSET :WITH CSINFO :NCONC (WHEN (<= 0 (SETQ CSET (FIRST CS)) MAXCHARSET) @@ -875,21 +880,21 @@ "BITMAPCREATE" "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" - "DISPLAY" "FONTDESCRIPTOR" "FONTP" - "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" - "MEDIUM" "REGULAR" "TCONC" "UTOMCODE?" - "MEDLEYFONT.FILENAME" + "CHARSETPROP" "DISPLAY" "FONTDESCRIPTOR" + "FONTP" "FONTPROP" "INPUT" "ITALIC" + "LIGHT" "LRSH" "MCCS" "MEDIUM" "REGULAR" + "TCONC" "UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) :READTABLE "XCL" :COMPILER :COMPILE-FILE) (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (3113 10051 (BDF-TO-CHARSETINFO 3113 . 10051)) (10053 16503 (BDF-TO-FONTDESCRIPTOR -10053 . 16503)) (16505 20438 (BUILD-COMPOSITE 16505 . 20438)) (20440 21189 (CHAR-PRESENT-BIT 20440 . -21189)) (21191 21475 (COUNT-MCHARS 21191 . 21475)) (21477 24512 (GLYPHS-BY-CHARSET 21477 . 24512)) ( -24514 25939 (PACKFILENAME.STRING 24514 . 25939)) (25941 35416 (READ-BDF 25941 . 35416)) (35418 35741 ( -READ-DELIMITED-LIST-FROM-STRING 35418 . 35741)) (35743 42741 (READ-GLYPH 35743 . 42741)) (42743 44128 -(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42743 . 44128)) (44130 46547 (XLFD-SPLIT-FONT-NAME 44130 . 46547) -) (46549 49561 (XLFD-TO-FACE 46549 . 49561))))) + (IL:FILEMAP (NIL (3116 10226 (BDF-TO-CHARSETINFO 3116 . 10226)) (10228 16847 (BDF-TO-FONTDESCRIPTOR +10228 . 16847)) (16849 20782 (BUILD-COMPOSITE 16849 . 20782)) (20784 21533 (CHAR-PRESENT-BIT 20784 . +21533)) (21535 21819 (COUNT-MCHARS 21535 . 21819)) (21821 24856 (GLYPHS-BY-CHARSET 21821 . 24856)) ( +24858 26283 (PACKFILENAME.STRING 24858 . 26283)) (26285 35760 (READ-BDF 26285 . 35760)) (35762 36085 ( +READ-DELIMITED-LIST-FROM-STRING 35762 . 36085)) (36087 43085 (READ-GLYPH 36087 . 43085)) (43087 44472 +(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 43087 . 44472)) (44474 46891 (XLFD-SPLIT-FONT-NAME 44474 . 46891) +) (46893 49905 (XLFD-TO-FACE 46893 . 49905))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 81ccb5771c9f8ccf0b0f5c1157d7f8d5b71b1a12..d112551a33a34cb55bdf139532ba2581acd4bb7f 100644 GIT binary patch delta 9083 zcmai43w)DRmjCXTG-=WYg|?KI+6F9bDWpJK1bJxFRJ1Xk<8}_HJqNC%C!=7{QP11)ii+q`!WWJ@6F!S>KwoozW|{Y#bPLU9|qvLD#^>!L^$QFLb#UyM2QL z?xy)o3tbDEmMmyq(lXzvd!m7CSn!I=FI;=|T-Rb3pa(CzU~r=gi_A@xS@7`Vy^K}z zsp`)BJa4-v64heih!N)d)o_kA==DbV&i*)Wx4e<(P2M_eT@}!MrkBsPR@Y-XFX&kn zYxjq+q=|;2kP-BR!~W0;=?uV|taZ%G@3dAV5HYDO?hp9fULzPbqW+jBiXqw^j%ZOW z6mz%vV`RdWzjc6X9 zyUnLlinrv)e)o|4G!H^XMJsld3q+2&aI6crChzA^S8e41B-z&7dHkdUZ z%s`v5in0>UpaxUojY4dZ!HE&3MPhy}N@-iP+wY6D3*DE|?ZUo*GVCHlCc3&bZ_E%e zXA?m|s7dh<#-HXplroxnD>Z*&gaLHNaIVi2^Tc|>+R#vP*wUuEVQOhSI7UdSr|vKW zz-Gt1gm*|8qA9cy=(ZtnVH2S?WG0}99bCxa-~zJ?G1h=T8XKZALlPy2N}_HTnZFQX zJ75aIQ}!TooA7uCcR9-v*8`>iFj>PYy(P1}{a7Ni23#V|q3r^D1ArXhEo+F^RYNMRrp523vFZb$o?U!rKJ7=Tl^PNKS1?eQr}1QSyJCa^+8gP zqsmEr_i7UF^pkj7Bk}u1B>ra>iMNVL923F*rX$s;`?r@7 znPCMivml%`2a(BUcM~4P-OZOEyzP-fl|VNuOd)?*g!;t*x7A2oynQ_O`ZF zhOW;iDhMSYq~i2CnA(h|g%;w|QY7TBo^NLtji z`><?+{}REXd=`%}XKLAg1&G2G-M9z4Gvku-mL`-x11w)S z`d&`?I)h0uK3`W-8U21%`74wt5MIBZSiZ@C(%iydDk)7kL`gA0qWdgA)vr@fDhsn>Lhs_rs-f70OpBSr@})zn=D91 z;;b25Dt07pN(R>o#FCS#IUQLNS)4%v&<4QNNTCk3Caip94#`3g#J4LzXY6nMx`A7o65E_=HQ=9D_!sg6@D}MvkA)*x$kYVzeAsbD36o=9$#2~nIPCG8dv~7JfwD@ zO0>&XqIw2d{is?ub;;Md zwJ!Numwc_K_*$2It!EuUznh~caI+4f=pb%R?b>+kwCi}pjPwvS+H_CQACP*t z=3mh+C^IJ-@DO_@Ae!OmNsHr9`oLP~@%au#V?6;aV{?Z6tF*wO^ikGH$Mj4(A1)|H zARhA@p+n+qJJBMVV2{FOBz6BN@N{XBglC0zD77@U*aw!TtbmG_W{sJ4pUPjahGTLTMe)&0`{$0lkh9D;A;S0Oz_iYRN$Af zA1E}Ik}&(Bz$7Y=HQmzr53{i6b5>mf_g0y?F)MQ|IGRk3z7-b|y(tTQ!FQoCW+Zy^ z5H(Vc)c~NyEJee?R6t4OmMp&)0#XbY2HV6~lkgv9IUeNiR#!BqYrQfn^CIw7NGccDW4|Q+CG{axpC|P}R39bv5UTr0{ROIYW@ZOb zCGutu5P7o$MBeOvIybZXh`ZT-!QK0Sy9=PQdsEH5hA*nQ(|rvCn`|jdiiZ+bfmJCf z79TA(^#T)^RR5sG3|$;^uW`Z1%H z68#NEeM#Y%QP28apQu}L!lM3#tKcl4To0B_3+l{It zMxjx4@>Zh|blzECZJnw1&*Yoy|2YSJRq=}1l^QsKY9T{51DZINYElKZvgVPMM$Lu| z##EyuWuMaDFt)*HIJtAfcBA3dAUNMT+rz5(6SFlI;+BTm#3YzP%WZH+%xw$AqU|0Z zZu^#{^3n)4OwNI1zBtac(+-5j8ZhPwBe6f&)aUR;KnwZ8nAn{u<%Jii7ZJhAvEp3wy$w}~-+@h`gAF5fFJ^0zh!I&&WyZVA=zO6~1E^&L+}k5sH~_C$nC>%4 zEF{S5XqgX)9DgVrr%qIee7L+pp8CH+ye-7OVeQ7(hY=MPoCaHwI`!CX4Eq? zDqXf1V%f{&l07ZNV?ykNrqFvMB8X%JcvITNa@LjBSrFib-YBwEilLyO@-&#ISS^yg zu$}n8bEaYX_`l5QD>g)wtKW#r`aKV;Cr8hmdz`6ozO*-9uriJ>qzxI7aG=yno(w{iqqj#7=4tPL;ZjRGb#}7WPEX-bh`HSG;a{hv8 zEIjI8(4w+1-`0EvdxP(3p1~sgNOSoH>f2*xCsuM$h`rdwc+8-?%DI@an*32DpF`?6 zT4$Sa6!glW=AcR^Sk(rqaw?5ezD8BGaZgJ{;#16fF6~Y^OnF#XIcQ>A6u6dyC#*oZ z-i-f1n}hOT6wn zbnGI(Cs3tZjarM2|3=jyK>0+d{N^P!Eo3-CC2-c{PC4EoEc0L;h-VT{B;x52o?qi1 zEOD1LAo_FiM7Nz2q|W8Dm(H+jU8dFw>#uXE&YE~~=|Olt^e%gyE#sBT{Ryh)L4teG z$$eB8wpZCf>L;lF7**xKN@1ZfRSq;mdvZIpo^B)J3yXWwD`kXu#dwUIsxr@yi1K{_-EfQ+?Mt^|dj&K&i`^8DrCNn}z4y+U|BEpe2WMNWwN5AKiCO zHEW1lvyUb@u;GV2@Pduaq)VzwyRYixAD!D&@@hWS?r>zXBfPmaJSjr+tU9MqzB+nq z>j`T@#m9!ChIpvkAM(NTBXq(WYcQ{JFbDwbMGJlh0l)CZYQ$i{xm%i=XF!JaWoUC= zmnRU{qHcV3M%&|51ec1HZs6(?RP$)fS{2Gfi{(R98SEPi6w9-uc&z4~7GpTRf|~wa&OFP)#iuC?RpN15j4{_6FnFI!aV#eL#r2h1ey;%|dLW zm1^BAQX3!@fr1?{#CF(*#djI#YN^1@C1LrDR=Z`l5I+@S4G9&W$#Q6iG4bhE1)|_D ztSF~5sp_Eej24)37i6=KgoXBPWe-|@D=g2@DBOvbUkS@Wvg}5SDJ&yo!4Gz=uxy0d zCts?VEc>t86Ees7Jjtj zN2T~RTp=87V!*p_ZHdB_8op==1a?(#g_E=hObqlPCKk`N%t{`&-5M+@z7f~4vo9Qr zw8ujoO)Y!OE?yVBigoe5!J4znlEZeN7VroCF>8PdUEsr&0kwJIkQIXe=Zdz9b?0CU zM3R3KoI9tN4)R%j&&9>$Zdtg{GM(J55ltH8@zA2B|Dd^wvM4#sTy-O>)jleGqZrtm z_L$wH&xY=@ux>sW>4a7EXvCE`AM5oHZVRf*NF6|xc1iXbsO+z373wikUxl>te`2lu zkt{SZ+TYQuOgRpPL9oA3=d);CJ0N%fHiN3?(S`FQ&t-KNk%tTWATyV~$cF_iLZogX*eqHgRz;8}%SqHx>)HBJ@WHM` z6W!by9o6XO&eoIlAf zie4hrMk_ivG2&_+aW{^*9V2cb6q$oOAEYWYlj9`R1H^ z?(dxY{@usSP%lRJm4eLjyVoP4>pp&ZkNerI2_%NuZYIm2MS!CJ+fe7m(7KA*PM zRwHDB5%c;?hb!n01tZ?58(^ocRjrs+dKHZSKy*&uJq?QK|EnB*+^13fuh`E8xacjqo-9Xwv=;|(@DTf~>!Hph(%llKmn zMxx=ED;f*C9YNy~w<}sM3?>ZA|2C3CUZUBgzx z8;#f~Cr{-RC|RUriISxxLG5!|4FWkJ2Xv8K=^O|hmvcc zIeI7}4Ctw1zjK8fJDhqDIuBX{b0FQ5)`&O0Qg&*g0Yhne1D!^&k9xVl?~aDOu1Exj z5C5)|z5gos0a2}H>56$RU+CF9%z!E87mI^AJS zmyUOUS21{Hb)9m$KOGx~?@oox>Qse%AaT3I-UXn12$$|@1xO}tua=1KDnzRP`A9)k zyddp@{jPj=r-E(=7er)6Mj`g35O*s?X1Ek$Z&nljL6xlrGF?*q!7SMK09Fp=#R7h3 zDC9N|jmMh_0e{#b_W%rsO!8Bz)(<6MP36Lx0$+(623#rNh;uSCC6OF<_}5-}t$p(r z{$GVN*uA{GsJUW)@_sFE`M*JUtyH68_H$p+Bxdjjt6SM-K2o%{#wentu4#J-Faj=6 zA9j-0Pgy$JRs1kxBmBdXH{(vU&L+(Js8*5sd#w9kNPQ30cSwB~)fY&82h}G@eH&Fy z>glZ{P7RTG%T3~U3rPHSDvAHBAn_(6aWX$u!2{e|`XD>NKPa7B@L`28iiKen2Cti1 z4-ImawdWhGkX&8_qHE>{%8dA;7IAZtxFz=@v2~ufb+&L_DE_WoxR`Ju!IdIgxim>O zF2!pu#cQryWmjzGQf%f@Z01sI=8|kCT#C$Gip*R?1PvOOT~h(ot0DIw@{H+}8_u*EQXiH$&! zOlC8TzM#i5N3xe;^rsVQ7E(rzAIgxtnUi6@TxY~Zv;~oErduUs`Hv)EhDy$Jz#fG) zU^c{26Oh%YQjdYDz!ePjJ5 z{gR57=9w=5RwM&`3)RTNzRX}!WRr>`QpNo*V2a1bk^Iw0l};1TpEIa52l0z5C&$0e zH!MFD_$zS9mx1MosfHG$0O!U7a3mF=Fa`K)rqIj?D^QUH!8AEP9+et;g(_B|mF#s0ITBqiViZvk%r%T*w9HrE3Qb5I8Dxf7(a(b#MU|Ci~D*)9% zq~{_3s_N3Ixl}Xlr9>hj`Hoe6og!HkQKSnfa@M@FuyizGff<{yOr~Lct&GH&oRF_u zCJLYeq!PtX%r<(yx=`=5U7+cAoQHqpo#fK(1Ua8f-ZyTYA}hW{_EYqEnm*sA&v$tD zq-!MgM$o`6!4Fz1%!?`!GV4P10s?fRY9ZAFs`e47Zd6|;)kO7KQeCL-A=N-hQYBt4Ft@fep+BDM?(=-o7qWwO1##RvW_PKqB)F}?=kdEk? zbP=2+gT7eQ8w?zh$J+50Sp{1p=(JKcxWO61pFP!-1mYpJ@=9Lf+W zO%P)C9J-REhq9#-)2(;jYTUtpr>F#Y>HZge_xNXW>=>u3X~2HcBe&HCgZh{`2~pnsghk z)u`VTrw#JY>MJu1ye=zqH54>~3d$N+Rm$~Q*df4{5%z0iuFyARq1R-gFHutjCxn7; zN>DA;n5+f39FxpsQNYbvaWCcn(J(R7)-734*70)`P6a4+gcO}VAAm(}s z3Ga`jK8fmkq#i=`IH^BI^`A(60@VYgK8`A#Z`qGfB|2q4BsygWiB8!8I^(j(h)vmk z$)@{&O{<_GkEW`3t2~5jJ9u~La=xc2!fxfCHr3{*sP!3MSJvDLWsGn8H%Zl0q?+Vs zrcUSgO!Z9aWTF$cJdRs#o+}uLM3HfB5}knPp8T&iYR7Z>1kuId4}oO)ndsuZ(|V_; z0j0vr;IBFZ@WOuTlhw9#@;9a(X7}^$%{ywnL-j|m7_uJ?*24*2(?$+o8?0wTb~e<= zw@+`aY&>^%ByfAM@kp>F*m!nlump7e{PYHEy*^aWKb-z(4!Sq;9W9fq!EZXm(T5sy zG1T$up{ApNKGrg^Mp?>-T90lFww@i?czdvQ%nzBLwm4ZMZ)rJi{#m+i|84RzX4;RG!iwU?RvaWy8~tj6Gq0%1&=yW zjLa^f{(A-0CdlV4GpggSK}vgYkgkn_vU&#C)OTnesE`=|-tADsqQMotZ38MQvFzq_Cw6iPtA6hoTNtyXGB(=x6P^ZJS%)ym+w+h*mwE>sn}cWchFX=$J-ai#0#Pu z#SyUO58x{qK8c~_DbdGw&WYB2go$>X?Qk9O`f!^o1e5kTQsDW5K+$e*@IQ7c6e z_9uo5mGfxZawndSSc|};6RVS=L<)_Bc1nulg3eJ-QIxY-&i6_EoWI_-0D7jly@mxw zr?t=1S%9yacL7k()_GG{i0_#a%GRzpHcr>4uk~)Ug z77;-~S8|=M?{vV@8CbRRX`J?FRCUJd=hwzR#=IBP;k3h)htAp)0_&pDZINLC+Fc@Y zz0AK#hFD3CV=I0-w8?ipg0{BDYu?M=$L76=OkuX2D_j+_P|L{aBoG#x_Y& zLU1daj#B$2|6-vNdiGrpE2L#MOn!NlcZS2x zemkxOq-B0=kz?XC#QzV)YDV=8snfZ2@f4e@N4S>5v&YQE9yW__Ui<{?ob^ji!uk1& zCEhrd^d!NTpyxp<4Qs63OX?X^X?a zfQD4hDVHvz*Er8uJJ?@f`jxiE0=?dV2@hmYTUWGI+?3B?tRaFv2ac)u2W%dU!rF4Q z&7Cuc4|^I0aPnK}nx}W5T1czVs*xL7EFVxw)u_HeD)zMHM+DGOjffZuxy$3y(f^xp zW8Bu+R78gR$?!g3&>3u@#dTIh0jQl8y(pf+E{epAh`Sq;k5TLa{&Z(^^-wn^v=JBC zhN$=182`AlK0Z`Qwsra7ZN;w?aPnA3iI%L7OYyK2yQH{Bito^>vu=^8jWV?Yy3hvu z8ZHOn#7K)|#!M2H&uQUWc1!U+;fe#svYL`QzNX~R4nwZGT=aS^m?yw_BOD$7<_ms$ zJ_Tj8fV4eeVV_6~?UCAUw7eoMzoHJn5B99IJVBOt5=}yyc97`-v}}`>O;|QIChIvH z0c$0ohg>*X=1L0n2>^|oWB3J* z%MEj^y)6&jAHsY|s((-FncFDJLCL5ed&vJX+K=?hB%`n6e_FAh&EdO!H^DM5^H=0J z=fit1FZEUOCH`%mn;8TqKb+eMCfCbWW+mILnl_Y#r#{nzGgSKn8Slh3TQCrchPz^c z747r(is;V3EiB5n2AV3$llXq;^ZLC}tB>HT`Qboy=|Ng(x|Ow|Q9H=r2+W+>1BHLB z(fRlt12lPVyQPlYSIQc#<&NNjMSrul3zEak-n?T_?)v(jGWuP6MQrrp;DZ(x<4Ypl zFz@e;*y96G5#33J+<@w0Qio8bEs%WzD*FnpQvEHduRtTw) z_Diu#io2!2?|$Gx7~TsIxk(x~qOV+?gVI8Kzg(SN(z2W|RLESgz=I;2K_*(A^%7J~ z7FwMeS+p<6gI32Y((=zxgM8wObfdIGh|;$Og&~*SJ4=K?G^@QmLl|_Q(oRnj23@JN zQ#N7PXyRyZ@h@V}u^#@9JwJiZ4ZSUDi`hpNd6PfbyRpN+j_NR$M}=5(dxaqv;?s0K z)Sqglj3*~c9~wTkk1y$)$9hLM_1(+ty>-yq%vplIV=Tb_lZTNFe9Fp6@y5$3%$fmU z={)*286IZjJZYQ{HjCRAttZHHlSnjD6WE3-jC3=a7+y{p9mW`5PT7@Y#mgzXlvKQ& zvQ?zw<&;H9#mi}o$xA5SP8qe2{Seh!|;1ixeGF$l)8~ z(*~!r<2*PxdD`)jQr$3D z^W1$QXTWsBFAFd?g4~L~7l41 zL6rs#?w_E_a!EDF>(^+N6!U8yUcJM*s8lTCzh6D2X=yIhq7q*s@l*z1fAo06!2lk~ qnOMr;hXPhHm$wXE2S1b$LwBhkN<2`$R9ppqdLT$E+fsf0{Qm(o4P-z7