diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 229d59d0e..a4c28123e 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,17 +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 "30-Apr-2025 13:20:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;61| 47500 +(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 GET-FAMILY-FACE-SIZE-FROM-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 "25-Apr-2025 10:10:08" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;60| + :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| ) @@ -23,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))) @@ -40,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)) @@ -55,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") @@ -98,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)) @@ -112,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 @@ -133,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) @@ -151,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)") @@ -185,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) @@ -200,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)) @@ -236,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 @@ -268,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))))))))) @@ -311,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\"") @@ -336,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))))) @@ -358,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) @@ -372,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) @@ -394,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") @@ -408,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") @@ -488,7 +509,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 +625,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") @@ -699,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) @@ -744,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") ) @@ -769,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) @@ -780,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)) @@ -801,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) ) @@ -808,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 (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 (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 1974ed359..927778eaf 100644 Binary files a/lispusers/READ-BDF.DFASL and b/lispusers/READ-BDF.DFASL differ diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index 8f6e2ec54..891c14cc1 100644 Binary files a/lispusers/READ-BDF.TEDIT and b/lispusers/READ-BDF.TEDIT differ