From 6a93166156f2bd30528aef106a62351cd893ed97 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 4 Feb 2025 17:38:24 -0800 Subject: [PATCH 1/6] Now can create the FONTDESCRIPTOR with all non-empty charsets. Can write DISPLAYFONTFILE format ("STRIKE") files for the charsets. It still needs a bit more fine-tuning, and waiting for prerequisite PRs to be merged. --- lispusers/READ-BDF | 496 +++++++++++++++++++++++++++++++++++++-- lispusers/READ-BDF.DFASL | Bin 9773 -> 17986 bytes 2 files changed, 481 insertions(+), 15 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index fa4689c90..3007b5526 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,20 +1,37 @@ -(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF")) READTABLE -"XCL" BASE 10) +(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" +"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT \FONTFACE \FONTFILENAME \FSETOFFSET \FSETWIDTH \FONTSYMBOL +\GETSTREAM \INSTALLCHARSETINFO \PUTBASE BITBLT BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH BLACKSHADE +BLTSHADE BOLD CONDENSED DISPLAY FONTDESCRIPTOR FONTP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC +UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) -(IL:FILECREATED "23-Sep-2024 12:38:25" IL:{LU}READ-BDF.\;2 12260 +(IL:FILECREATED " 2-Feb-2025 21:19:45" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;17| 39134 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS READ-BDF READ-GLYPH) + :CHANGES-TO (IL:FUNCTIONS WRITE-BDF-TO-DISPLAYFONT-FILES GET-GLYPH-LIMITS BDF-TO-CHARSETINFO + GLYPHS-BY-CHARSET READ-GLYPH BDF-TO-FONTDESCRIPTOR PACKFILENAME.STRING + GET-CSET-BITMAP-LIMITS MAKE-CHARSET-BITMAP) + (FILE-ENVIRONMENTS "READ-BDF") + (IL:VARS IL:READ-BDFCOMS) + (IL:VARIABLES MAXTHINCHAR NOMAPPINGCHARSET MAXCHARSET) - :PREVIOUS-DATE "22-Aug-2024 20:54:00" IL:{LU}READ-BDF.\;1) + :PREVIOUS-DATE "23-Sep-2024 12:38:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;1| +) (IL:PRETTYCOMPRINT IL:READ-BDFCOMS) -(IL:RPAQQ IL:READ-BDFCOMS ((IL:STRUCTURES BDF-FONT GLYPH) - (IL:FUNCTIONS READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH) - (FILE-ENVIRONMENTS "READ-BDF"))) +(IL:RPAQQ IL:READ-BDFCOMS + ((IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH) + (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) + (IL:FUNCTIONS PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH) + (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-GLYPH-LIMITS GLYPHS-BY-CHARSET + SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) + (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP) + IL:FONT)) + (FILE-ENVIRONMENTS "READ-BDF") + (IL:PROP (IL:DATABASE) + IL:READ-BDF))) (DEFSTRUCT (BDF-FONT (:CONC-NAME "BF-")) (NAME NIL :TYPE STRING) @@ -24,10 +41,43 @@ (PROPERTIES NIL :TYPE LIST) SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST)) +(DEFSTRUCT (GL-LIMITS (:CONC-NAME "GLIM-")) + (XCODE 0 :TYPE INTEGER) + (GLYPH NIL :TYPE GLYPH) + (WIDTH 0 :TYPE INTEGER) + (ASCENT 0 :TYPE INTEGER) + (DESCENT 0 :TYPE INTEGER)) + (DEFSTRUCT GLYPH (NAME NIL :TYPE STRING) ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP) +(DEFCONSTANT MAXCHARSET 255) + +(DEFCONSTANT MAXTHINCHAR 255) + +(DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) + +(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) (IL:* IL:\; "Edited 23-Sep-2024 12:37 by mth") (IL:* IL:\; "Edited 22-Aug-2024 16:43 by mth") (IL:* IL:\; "Edited 17-Jul-2024 14:45 by mth") @@ -124,7 +174,8 @@ (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-Sep-2024 12:38 by mth") +(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 2-Feb-2025 20:29 by mth") + (IL:* IL:\; "Edited 23-Sep-2024 12:38 by mth") (IL:* IL:\; "Edited 22-Aug-2024 20:53 by mth") (IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth") (LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT)) @@ -150,7 +201,7 @@ (SETF STARTED T) (SETF (GLYPH-NAME GLYPH) (STRING LINE))) - (T (UNLESS STARTED (ERROR "Invalid BDF file - glyph has ben started.")) + (T (UNLESS STARTED (ERROR "Invalid BDF file - glyph has been started.")) (CASE KEY (ENCODING (SETF (GLYPH-ENCODING GLYPH) (IF (EQUAL -1 (FIRST ITEMS)) @@ -174,7 +225,7 @@ (THIRD ITEMS) (GLYPH-BBYOFF0 GLYPH) (FOURTH ITEMS))) - (BITMAP (LET* ((BM (IL:BITMAPCREATE BBW BBH 1)) + (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)) @@ -197,7 +248,7 @@ (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) (SETQ BYTEPOS (* 16 (1- NWORDS))) (LOOP :REPEAT NWORDS :DO - (IL:\\PUTBASE BM.BASE WORDINDEX + (\\PUTBASE BM.BASE WORDINDEX (LDB (BYTE 16 BYTEPOS) BITS)) (INCF WORDINDEX) @@ -208,12 +259,427 @@ (ENDCHAR (SETQ CHAR-COMPLETE T))))))) GLYPH)) +(DEFUN BDF-TO-CHARSETINFO (FONT CSET &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 2-Feb-2025 21:07 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?") + + (SETQ CSET 0)) + (SETQ GBCS (COND + ((TYPEP FONT 'BDF-FONT) + (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE)) + ((LISTP FONT) + + (IL:* IL:|;;| + "Assuming that FONT is already the A-LIST form of result from GLYPHS-BY-CHARSET") + + FONT) + (NIL + (IL:* IL:|;;| "comment in COND still must be well formed ...") + + (IL:* IL:|;;| "((TYPEP FONT 'ARRAY) ;; Assuming that FONT is already the array form of result from GLYPHS-BY-CHARSET (LOOP :FOR I :FROM 0 :TO (1- (ARRAY-DIMENSION FONT 0)) :NCONC (LET ((CS (AREF FONT I))) (WHEN CS (LIST (LIST I CS))))))") + + ) + (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) + AVGCHARWIDTH GLYPHS-LIMITS BMAP SLUGOFFSET OFFSETS HEIGHT WIDTHS) + (SETQ GLYPHS-LIMITS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT + (LET* ((XCODE (CAR XGL)) + (GL (CDR XGL)) + (GLIMITS (GET-GLYPH-LIMITS GL)) + (GWIDTH (GLIM-WIDTH GLIMITS)) + (ASC (GLIM-ASCENT GLIMITS)) + (DSC (GLIM-DESCENT GLIMITS))) + + (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLIM-DESCENT calculated by GET-GLYPH-LIMITS will not give a useful value, since it is >= 0. Investigate correcting this.") + + (SETF (GLIM-GLYPH GLIMITS) + GL) + (SETF (GLIM-XCODE GLIMITS) + XCODE) + (SETQ FIRSTCHAR (MIN FIRSTCHAR XCODE)) + (SETQ LASTCHAR (MAX LASTCHAR XCODE)) + (INCF TOTAL-WIDTH GWIDTH) + (SETQ ASCENT (MAX ASCENT ASC)) + (SETQ DESCENT (MAX DESCENT DSC)) + GLIMITS))) + (SETQ SLUGOFFSET TOTAL-WIDTH) + (SETQ AVGCHARWIDTH (ROUND (/ TOTAL-WIDTH (LENGTH GLYPHS-LIMITS)))) + (INCF TOTAL-WIDTH AVGCHARWIDTH) + (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 slug offset") + + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I + SLUGOFFSET)) + (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) + + (IL:* IL:|;;| "Initialize the widths to AVGCHARWIDTH, the width of the slug") + + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I + AVGCHARWIDTH)) + (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 HEIGHT 1)) + (BLTSHADE BLACKSHADE BMAP (1+ SLUGOFFSET) + 0 + (1- AVGCHARWIDTH) + HEIGHT) + (LOOP :FOR GLIM :IN GLYPHS-LIMITS :WITH GL :WITH GLBM :WITH GLW :WITH XCODE :DO + (SETQ GL (GLIM-GLYPH GLIM)) + (SETQ GLBM (GLYPH-BITMAP GL)) + (SETQ GLW (GLIM-WIDTH GLIM)) + (SETQ XCODE (GLIM-XCODE GLIM)) + (BITBLT GLBM 0 0 BMAP (+ DLEFT (GLYPH-BBXOFF0 GL)) + (+ DESCENT (GLYPH-BBYOFF0 GL)) + (BITMAPWIDTH GLBM) + (BITMAPHEIGHT GLBM) + 'INPUT + 'IL:REPLACE) + (\\FSETOFFSET OFFSETS XCODE DLEFT) + (\\FSETOFFSET WIDTHS XCODE GLW) + (INCF DLEFT GLW)) + (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) + CSINFO)))) + +(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL + MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 2-Feb-2025 20:46 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 (FONTDESC DEV GBCS CHARSETS) + (WHEN (LISTP FAMILY) + (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY) + (OR (SECOND FAMILY) + SIZE) + (OR (THIRD FAMILY) + FACE "MRR") + (OR (FOURTH FAMILY) + ROTATION 0) + (OR (FIFTH FAMILY) + DEVICE + 'DISPLAY) + MAP-UNKNOWN-TO-PRIVATE))) + (WHEN (FONTP FAMILY) + (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:FONTPROP FAMILY 'IL:FAMILY) + (OR SIZE (IL:FONTPROP FAMILY 'IL:SIZE)) + (OR FACE (IL:FONTPROP FAMILY 'IL:FACE)) + (OR ROTATION (IL:FONTPROP FAMILY 'IL:ROTATION)) + (OR DEVICE (IL:FONTPROP FAMILY 'IL:DEVICE)) + MAP-UNKNOWN-TO-PRIVATE))) + (SETQ FAMILY (\\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) + ((SETQ DEV (\\GETSTREAM DEVICE 'IL:OUTPUT T)) + (IL:* IL:\; + "T coerces here to primary output") + (IL:|fetch| (IL:IMAGEOPS IL:IMFONTCREATE) IL:|of| (IL:|fetch| (STREAM + IL:IMAGEOPS + ) + IL:|of| DEV))) + ((STRINGP DEVICE) + (INTERN (STRING-UPCASE DEVICE) + "IL")) + (T (IL:\\ILLEGAL.ARG DEVICE)))) + (SETQ FACE (\\FONTFACE FACE NIL DEV)) + (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 GBCS (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE)) + (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)) + (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) + (LIST CSET)))) + (RETURN (VALUES FONTDESC CHARSETS (ASSOC NOMAPPINGCHARSET GBCS :TEST #'=)))))) + +(DEFUN GET-GLYPH-LIMITS (GLYPH) (IL:* IL:\; "Edited 2-Feb-2025 21:07 by mth") + (IL:* IL:\; "Edited 29-Jan-2025 16:28 by mth") + (LET* ((BBYOFF0 (GLYPH-BBYOFF0 GLYPH)) + (ASCENT (+ (GLYPH-BBH GLYPH) + BBYOFF0)) + (DESCENT (ABS (MIN 0 BBYOFF0))) + (GWIDTH (MAX (+ (GLYPH-BBXOFF0 GLYPH) + (GLYPH-BBW GLYPH)) + (FIRST (GLYPH-DWIDTH GLYPH))))) + (MAKE-GL-LIMITS :WIDTH GWIDTH :ASCENT ASCENT :DESCENT DESCENT))) + +(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 2-Feb-2025 20:29 by mth") + (IL:* IL:\; "Edited 28-Jan-2025 23:09 by mth") + (IL:* IL:\; "Edited 27-Jan-2025 17:22 by mth") + (IL:* IL:\; "Edited 23-Jan-2025 17:58 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 (IF MAP-UNKNOWN-TO-PRIVATE + #'UTOXCODE + #'UTOXCODE?)) + ENC XCODE CS XCS) + (LOOP :FOR GL :IN (BF-GLYPHS FONT) + :DO + (SETQ XCS NIL) + (SETQ ENC (GLYPH-ENCODING GL)) + (SETQ XCODE (FUNCALL UTOXFN ENC)) + (COND + ((NULL XCODE) + + (IL:* IL:|;;| "These assoc with the Unicode encoding") + + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + ((AND (INTEGERP XCODE) + (<= 0 XCODE 65535)) + + (IL:* IL:|;;| "These assoc with the 8 bit character code within the charset") + + (TCONC (AREF CSETS (LRSH XCODE 8)) + (CONS (LOGAND XCODE 255) + GL))) + ((LISTP XCODE) + + (IL:* IL:|;;| + "These assoc with the 8 bit character code within the charset (like above)") + + (LOOP :FOR XC :IN XCODE :UNLESS (MEMBER (SETQ CS (LRSH XC 8)) + XCS) + :DO + (PUSH CS XCS) + (TCONC (AREF CSETS CS) + (CONS (LOGAND XC 255) + GL)))) + (T (ERROR "Invalid XCODE: ~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)))))) + CSETS)) + +(DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") + (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)) + +(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &OPTIONAL MAP-UNKNOWN-TO-PRIVATE FAMILY SIZE + FACE ROTATION DEVICE) + (IL:* IL:\; "Edited 2-Feb-2025 21:19 by mth") + (UNLESS (TYPEP BDFONT 'BDF-FONT) + (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) + (WHEN NIL + + (IL:* IL:|;;| " older form:") + + (LET (FONT-NAME WEIGHT SLANT EXPANSION PIXEL-SIZE POINT-SIZE) + (SETQ FONT-NAME (SPLIT-FONT-NAME (BF-NAME BDFONT))) + (IL:* IL:\; "Parse as XLFD format") + (POP FONT-NAME) (IL:* IL:\; "Don't need FOUNDRY") + (UNLESS FAMILY + (SETQ FAMILY (REMOVE #\Space (POP FONT-NAME) + :TEST + #'CHAR=))) + (SETQ WEIGHT (POP FONT-NAME)) + (SETQ SLANT (POP FONT-NAME)) + (SETQ EXPANSION (POP FONT-NAME)) + (UNLESS FACE + (SETQ WEIGHT (OR (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 (CDR (ASSOC (STRING-UPCASE SLANT) + '(("R" . REGULAR) + ("I" . ITALIC) + ("O" . ITALIC)))) + 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") + (IL:* IL:\; "Ignore others") + (SETQ EXPANSION (OR (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) + '((#\R . REGULAR) + (#\N . REGULAR) + (#\B . BOLD) + (#\S . CONDENSED) + (#\C . CONDENSED)))) + '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 FACE (LIST WEIGHT SLANT EXPANSION))) + (POP FONT-NAME) (IL:* IL:\; "Don't need ADD_STYLE_NAME") + (SETQ PIXEL-SIZE (POP FONT-NAME)) + (WHEN (ZEROP (LENGTH PIXEL-SIZE)) + (SETQ PIXEL-SIZE NIL)) + (SETQ POINT-SIZE (POP FONT-NAME)) + (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))) + + (IL:* IL:|;;| "Don't need the rest of FONT-NAME ") + + (UNLESS SIZE + (SETQ SIZE (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) + POINT-SIZE + (FIRST (BF-SIZE BDFONT))))) + (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPEDGLYPHS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE + MAP-UNKNOWN-TO-PRIVATE) + (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS + (PACKFILENAME.STRING :BODY DEST-DIR :NAME + (\\FONTFILENAME FAMILY SIZE FACE + "DISPLAYFONT" CS)))) + (VALUES FONTDESC CSETS UNMAPPEDGLYPHS)))) + (DESTRUCTURING-BIND (FOUNDRY FN-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") + (UNLESS FAMILY + (SETQ FAMILY (REMOVE #\Space FN-FAMILY :TEST #'CHAR=))) + (UNLESS FACE + (SETQ WEIGHT (OR (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 (CDR (ASSOC (STRING-UPCASE SLANT) + '(("R" . REGULAR) + ("I" . ITALIC) + ("O" . ITALIC)))) + 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") + (IL:* IL:\; "Ignore others") + (SETQ EXPANSION (OR (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) + '((#\R . REGULAR) + (#\N . REGULAR) + (#\B . BOLD) + (#\S . CONDENSED) + (#\C . CONDENSED)))) + '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 FACE (LIST WEIGHT SLANT EXPANSION))) + (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))) + (UNLESS SIZE + (SETQ SIZE (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) + POINT-SIZE + (FIRST (BF-SIZE BDFONT))))) + (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPEDGLYPHS) + (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE + MAP-UNKNOWN-TO-PRIVATE) + (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS + (PACKFILENAME.STRING :BODY DEST-DIR :NAME + (\\FONTFILENAME FAMILY SIZE FACE + "DISPLAYFONT" CS)))) + (VALUES FONTDESC CSETS UNMAPPEDGLYPHS)))) +(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY + +(IL:FILESLOAD (IL:LOADCOMP) + IL:FONT) +) + (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") - (:EXPORT "READ-BDF")) + (:EXPORT "READ-BDF" + "WRITE-BDF-TO-DISPLAYFONT-FILES") + (:IMPORT \\FONTFACE \\FONTFILENAME \\FSETOFFSET + \\FSETWIDTH \\FONTSYMBOL \\GETSTREAM + \\INSTALLCHARSETINFO \\PUTBASE BITBLT + BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH + BLACKSHADE BLTSHADE BOLD CONDENSED DISPLAY + FONTDESCRIPTOR FONTP INPUT ITALIC LIGHT + LRSH MEDIUM REGULAR TCONC UTOXCODE + UTOXCODE? WRITESTRIKEFONTFILE)) :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 (983 6167 (READ-BDF 983 . 6167)) (6169 6492 (READ-DELIMITED-LIST-FROM-STRING 6169 . -6492)) (6494 11972 (READ-GLYPH 6494 . 11972))))) + (IL:FILEMAP (NIL (2544 3969 (PACKFILENAME.STRING 2544 . 3969)) (3971 9155 (READ-BDF 3971 . 9155)) ( +9157 9480 (READ-DELIMITED-LIST-FROM-STRING 9157 . 9480)) (9482 15064 (READ-GLYPH 9482 . 15064)) (15066 + 21132 (BDF-TO-CHARSETINFO 15066 . 21132)) (21134 25644 (BDF-TO-FONTDESCRIPTOR 21134 . 25644)) (25646 +26243 (GET-GLYPH-LIMITS 25646 . 26243)) (26245 29272 (GLYPHS-BY-CHARSET 26245 . 29272)) (29274 29637 ( +SPLIT-FONT-NAME 29274 . 29637)) (29639 37829 (WRITE-BDF-TO-DISPLAYFONT-FILES 29639 . 37829))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 3408119194e806ad4feb59000778d70941566178..e0cae104e07ca50d1e9637857d02693393bc3c60 100644 GIT binary patch literal 17986 zcmb_^3w)ecb?5he8jYTwjK^bHmSuUO$cn6Z9NP&=;}E0K%%_>rJgzb`vZd6CBF7@5 zM`UB!KnNjnUgR-xEGrIkAxR+%g_5N!nUdPFt=S)R0RbV&VpG_*w3Mcy+lBS6fBSW@qN`@ zzGPH2m1j#H9^W^3|7Op254aB=9z1xzhl&89%G^|a`Niz>#x?sj{Bv*Nr-q=FD|JR! zQO2nmdiF%d(G`xGe)KM72BN}mXxV2o&h})=7Z3On0dF|o)0=9~W}MqRhxQ-vjtzZy zXpE-eJ_A)`k7X*mdgK07Sj4l_`lPWQ6*>cES2%8Zsa_QC5>C`;6Fp|!s6hd{=uM$Y zJHV)6fNsbn#g0-vKbo_8ErTFdPE|X%~a+WAe(90od~B)S`2SWcmt>?>g(?k@f7zt znVoK;euiUQ@IhRHBYNY(rN9z*YH0JYdF?CS@wDNdV}e!3NBvKN0Rp zi3Bj^gy|uGg#my)jBbbhgo;}2+oFjijo2PD1L0m8UPZzT_C|eNLkf)%du4A*^!WvM zswxkE0EAV%B$%3T#N^q=1e1i&qNRMD$f%_~ma);)RO{J{{ek%5v9Sj=NV|4*QP5ey zS=w_9u2HfM@!7saf+vU~%Sdo_Cv_O}-jfhLW$Tcs&5H}fEold$isU%}ElHBr6r{UjVjBv&U#Gxk~4;I;=G}KQ^A*q^Gq(0Pf64os=z40Iy zFZ7>t8+fn*llx`{NVlL12@&&_6scyWLYFIK91XZEB`OhNu5q=6Uo1?j=g4*H8J1{G?<}P2f18dnsf`#=9 zphmyw=_lhsA`UbZpO-c&d;#JF-o^_!ZD6D;*`As4UEzd?$4qFotSPlBT#t?9$EpUh z;v-p=z8bZ7C=9WpIJIoX z1zW4+*OM3AqI#6=lsh+J4%Tffh`869TrUkX)!$>1nA?;6$&?wZg~4~jpm}@9t_4Vl zlwR0x0cACDdtsKb!xTw3LfcoAP|U>j(!7TDqC#n}=ywUyRdsl!U0R_d}+x4eH1nv?g_zu9R+ zK8PAh|3$U+=&R9_lqTkBMa&mb`wPhr$zu($wt@iLlHog)DA#m~-gp37*(v&1wyR?% zwA7!(^r<{al$l6{O=UCeNjC9Jvj>WBg~D%RLWLq&nO(auYeJa~yHYc7JqsPMmTq#A zEL4{lVk#fTsy~g+R_CR_+r!LjAs@cpXsWnk-X2&JnsbboG>P|9HQq^Wl2^yh)nz8p zm>tWAVNS}AfxiNcS(7oXc%C61+O|`Z@&Sv(nk0+k=pqP&>g5@@zhyt&uUm< z)Kx)!3z`Ydn3NAu7g1o*)LQ(<3f0ocCoRrJlWuWNO&(FaN5E8t>Iy4iF&xh`JZv!( zmd9e4&NDm$hU!8Mv`iMqb9s(OEso+sS{x_x9FJKX#nrVqo?kSg$F08P*L_k^pTq(g zP`OH<-)|<9*ypj?_9U=(`?1AMPEKks@N|C$n`>pqH^>w?HH87F^R7u&4elH(rKTIu zL^epxY*^UERMuuGh>8wSg=*`CB0rmHGT{hyV);W}2!2=6OSVDuq_9`sVJ4C*!Lq8z zlJ7J2wj=CQv-3lx9#`h|&y7ODUxlls2NYg3^||o92AOKzlBHLbQk6 zS}uaL+im1xNTY6BPPE5gw^!tZ^Lf!O9PY}Ta1-QmSLZ}ML3QrhoMob^ZZ|5k&y3v*+Iy~%0iyhr1^vGg_$>zC zB=9Q?zCqwLgRkGu$@d31dClbHdpC3P-Hn`lXB8(4%C3GpFOB4~KG1PW>DAOs!!XND zh=0>+qu#6KX8!hWw54t6>sZjRT%nEy1FMC^hQ$hXe8*lv%Y}R;)(S~A779r%Rtbp% zON7LU^+Dpo;vjKjWkS}%yr?fyr8P&`Ng|7lwY9V%Wo)Mzx#$lga2#%pBI@%o{n#<44%82da&UxGOpdv#lz6ncm%o{kGk!-cnn$^w{-8Vip54zb?{p-QA*qh;1wi* z*NCi_S_MFPdDH9>Ouf@qR*)Xcirq%z*6r7GQhqfjwyQWPV_T#f`6>7%ra=6AZP9`q zBZPfnOJt4lmy7L7@$9QNP)D@?rfiB{wMurakWg1^x!>ES)bp&rhfTSv)TZE=O-pk{ zdlF=O64Ygo>`5)zlb~f!f|flATJ|Jp*^{7khzMGTh@f?d2wI1Tpmm4{T8D@r4iQ{$ z9or#rFaK|eRU(UnKmd*s1#Pb7smp*+X~q#q;qyG>rug?b|Em4zIfhSwx2&^sHybJd z6mK98yt5B6tF8G=e<4F5Cqx!31I4CHZJT*prf;C~+@nQytlF|;9MWJLhIv$iol$1s zB~J8}C=VM3zQusRLoR}UsA19e+1i<%_8InS`Rl!3!TJd64@d4`5!GsR`J zYH7(ctt(~9FR#V4G0)TpCTj}w%dRZ9-n7(m>zkHZZhaF}YI(~Y{JkufhhH$G?Y>rL1`jNBPdO!6b~rPMDc*qTuNyHrIjcxptP1!+CXV1N*gHcrIgK} zY$3{KP`2b<{;lNlZ?#j-j_)89Z)JvseN1T~V= z-%OB)oc>mVTFB{dC#a2_{w)M;cGu;^R<#T08`dt~=~l2&Qf~FPv6U6g80`tKG4=cW z`#S%=!M|^UlZ=>3LbL^1lCMCPZ-AEZ(pJ#+x1NNX_C}~$(Yx2ns7C#EYVMyH>>-d_ z(*=QFV{Dwj&oCGx@Cbq0oA+|^MvRl!m9zhSa7S|F4_u@9yq* zEYx8^EU#a0U%V?TFJsA$oLVJ=D5I#;&P^+H{Quock(qghNO+9IGJXL=nP#nI2hVTqV18{I{AS6WHJKBsn3wIk50M zbYsnuZsbGerTyR~-BZEIooFF z?}mH0X~|CsPm zUou6RXOXdUz>+olFwTeuSl80 zjG5S>61p;2?wZA*`k%^X47zZjUlyxYoQv10gcjoQBwIWao@K-VHRsjJBX`zN z4=8NrwWiLx0J7DAQ0YqqDb$)=DTQ()hIJ|Qb);mNkk;KHLH#S|6v48d?DIPHe0rQB z54m*c9UNxp*Wh0p|JwPtl7FlDx0Zhq4Fe~(PW-xZBlvZf*ol?8-ccNG5mJskm=O=d zZ+(uM=Gky-A-6HgV93k&)z4&G-n)Z}hGiuV64#zvnX!usVuq>$>U#Md#<|X?wqd1=nS%e&< zSkusXoPri?pM7|?tRhd^2dp#q@~rW{LkmtW#XtQz@YT7nK`FvF3)Nh0w4!%npHMJ3NnmeTdDL$^3oge@}i%M#@6PPS)7~sV%WfvXt`$=&oP=0 zEojU>X7IGr$~kg7N|#uJ$joY=&6f-;>O@jMubo8A|Q!{nl7(Zyt)H)X(y>NEs?XUqof40!@ z3DROL`fq;)#&iQ2gZkV^ha<;>!et{u7VW+9-K?Mq7*v0%T~0uFb#mtXQIW(II$bW% z{Xz|00Q*hvjW=%Fz6P3E7K8TI;4-(@O!7T7;p!#r1I8tg%FRSVaPCjoJ|88*Lm(I% zuP5-M0PVOB52iwt9V;@W7(77OFqrT@0(V+;BSjdxiLB?NxVpzu?_%gO3~xDzVKo)u z8}cX~zW}3G7OK`xNOm`$pth5}ok{cd2bg$_UT#$EiS43h1gK7~q2%UW1#+g_h+TWS znM+NtRW&XmtWuP<5!yp1a2`Pzc%uE6G~Zsw?~zm?QK<7*(4^Ibbf zy^Ujx)_(-_Rq*2y{1zgA^GE~wmSQ-|eK|pxR}|*6jCqbQ&nnELjF~3PguUFk7i<>gS@HJ!06P7~EXs8DO;k#Tad#G0zg_D+=>6D&cE;8K?r<_~&e9 zM|k|hgJZ+{=w@3zrt*4t;GTQ-A09vCY5Rn4lV^CsGi| z%ha%BjtX@JHhK2#ADZxt??2?hqp*9@p22$#9UdG*Gl5N9;l6Ap@OxDFuXe7}I$fM( z^|f?ZTX3?1TIORxBkOcLJ@XK(87tvFm>AlAPVNM-P)#o0$!&{?j@-%hM09WgG9EDa z$ddVZJpE{zUBV4qoH@8@ZjjmF4jx_7o6}?oY`O4hvISww|9ir~^3o#ePrh5_x8Ga| ziuMxINt3n58T`=4dD&mO1Cm~$M8BttDcMabSLFr5m_^j%hZkT&JU+qg60YE6C|A+|Sbmqj59V!-bh-_XfT| z!J%{b$A$*Sy@wC*>$wRW!!+(A4SQ0jTd{I7eWq?BU&YsnM{62iS>ka9-W9$}fQy&e z%gHa^D|+^S&~tEb{NAB0qvY(t3ed~B{FMc69dJP&Pwm3>Dqio&fIFMYJ~cFQ z>A4{|IN4EaFU<{&{&?i#m&S}i$fA~eQi&*mykH%9k!6vtMMt%MYljCvc6gTHEBUAL zc4Kj{qYMWcelus;XDo76D_v`gxDU@15ys~iS2i|<`f+-cQG<1%EBHA6{{RhGdx@i= zaN~Q~MdkfXPUzbd(Kd>~UJaFl%(3=y&y}W??72L3Pw?3vbuOoCH@vS*ol~FT7_)w& z0=-$q`_bZuVd&D`%L_R-@}8@Ab2g)Uu049Ev4{CzRoegOFUSOHC29E=UJ4(3vkTQc zo>ENhyD*M-VU(j?TFS*dD|m`<^Pk4qIgOLE3ja~KFAT5Uc&LNf?tr`gA?2rWe!!)l z6)r=+Q{gUsu{*{U&8hsED7SR+J{I8mm~W3 zrXoioI=R#OMT`7`qS8guto~O^k#-=zxfBWKP@i3jBv<=|rAYFzKWQOP-fFd^5AfwN zcOC(N0lq`Fa)wUFj(i3=H)=4g8eX2&w+e@FjWuNSfZQF**yU<`SN>K%?w4QtOZmOM!92?n2k zkdtX;5jO1N+*Cj%s>f3vm2;@11%-|OL7N)3VDjaZ5BqmANQ4NT>ASJlc=5Vg>^A9D zhY_HCHQ@_{`;gOrh)u(a7E|^+TGr6JyvnUa2ruj3M7xyTlmnzY|91$^Wjxd=(u~ z8?YL`kY<>Ry?L87Rbcv!>!hh-)32|Urh1F={R(;*MK!-h&X93eHnVA&eSh!ZKF`?j z_z;|8kGdM#;rWD*3N%^%4^{D#Y^Hsg!uO8de<1Bi4^F^y7#jCX92z``FC5sBI=6fY zb|h#VXm4V8-;jr^*aE3Zsa>ILGdUQkFccQf5iIjv-Eqf zkyDRsvK^g_n%U4nTsZkY*1@sPsg9?VMPc$OUufN2x1slA12{7>H*#j=?D*x&=a^&u zZVVU?s2m7^kCpvs^hbZM_6A&qIB-Kmb`N%2xUiQjX27k9lNg+MR0V6{LJcF<{SrM9 zquV5U5Jq=L^!$s>U%Fwy1B()d<)B+2(ZX%P{yi^RbV4+XR-J59t1-~7`mtGATO00u zgaz9Nwie*Zf$e!%v{OeF5AJQWTuij#a34D&+RnvA+oh>Ep!sgG<@~^na}lxi5;i5V z^-NT3zcdv+BDS9un_J1;wHWB$?ByZhF))s9jGHFHFgufD%vtKg0`H(;&q*m=0W#)YhA5`cPsu;ehO~jMEe`UN#klF zsEr_}Xgfc!83IJp?&0}Y(~0+acFdQfoujGqIC?@aLhj-R)`pUHMYzs45Q__|8|RCW>aWtAvnZakxM>_zK8Cwe)z zMWFuUBFJ}<%z(X*Xv~n{(t4LlcBo{FN}4&*9!A$(wz85A^Bv?Zc)I>^yoc1ZJMd9e z-geT)4*QyH%VyT*asKq+K|~Jl@!7=CAtJ&U_F69TW7g9_-((t=>LX+t$)oj=ZQC;y zeaxrsae^H_-Dl{)Om_MV2A=Rw`5#p_(omR315<&?5s)ngbIN>_g|KTy1z9|&k7fU4 zqQl2%*6q%z&ZkPUsI)YT8cVaNu{685UYO|4qE$y%AMaEFN#&_2vz-f^Tpv(e*}w>F z6$h+e32@JHkBscC%$cXnlf5QIGCpMvUsMdo&6%LdogQY*??1UJtTc9uN;c12YpT($ zQYp_2kML=QP*ZW*pAK^kd+pYx`kr&qFj-EdK3G#qJ7H=l^+OFQ9eJ(NN~^52n$rNx zUhJ%|(;o;UN`imRMdzb2IMVTRW0yyNG|bJPjm^iR?xtM)R7V#h<`9Y9bFQ18E99Ri z#JTTNGpRUS_FRnoYzN$R__a<<(G$XHZHy<^cMHqChVw35!pVbyElD>_(*6V2wr*`M z#?_sR8}ljIBFB}E@t}> zfhlsOtuRt=j~^fP5LTVqKTqIx*+_|M>;D4O{+Ua2%<7wR9bs~^my%OxtCFUP0!M`S z6XyI4fuAmdPb*M`IDRuOH{C0H9pEtzpfCDu1dYO>wc&d-8m9hnRJ+<%Mim!7-eZeH z)KPgYC7slEIEEWB(UT;^t*DH?%uqpWeKY9R_nDyLUKLrjP?Y^VmCi3AAx;3nOG}x@ zDMQQs5h|qw;BI*>J`11=H66l$J5XYL3m+ThZ5;8FY5T;+4*rklA9S- zH~-G#!kNGMzb#^Urb2~Kre^T{u0G)U*`CT5)uywBvxFsx}8>W_x9c-jixYy>?WX{9?JC9N`-w_U@ z4^pukjpq;G2;Zrj1QOsYTPgCG^e?l3kp0p3LUwHUq=xm9PlWof2_I(`1}W0FGGWHV zF4G(6r5i4IUaXNE^Hcmzxs{5kFfm(_Uob{fhgC9Z+85+j)xv(Cs{JOFY(fL->8LM} z@b%N<8yh{SsiqqHkSp{1*j-D)h?F6+P53bI`uhpm0jQiWlPLE-uJfJ!GT0-{_si|u zb-F1}Go(Xq!M_4#oPe+bTJ{B20KR5H;kb!0Ev!S2XPK3ZTe^_GcvLh_4`G0eJN5aPF~IvVWNW~MGm_3*Eh1|5IsaGH6NjZEW$A{O zVM5KnK2{M`6U5f=2RI^)4T=Wd+8f3`hIDfHglHJ^TsR^c-sDcL!#V1>Xi#3uStaA| zCd`jj2}im+XrOn-{kjqq{uDjFL0R>KWZ&n7NUlaGO58_&^YTtuxG z^~|r_vVnRj>c^^iKH-kk=K^2dF6v$s>UKc!0N*ez8fI{6J1**UECtYf&FhoM=_yLtYpb zKI`B+^Pfed@Q7w|hBVpl*0f4X0INz|A$)|4Z>jNz4p_RbY(#z!r^yAKG<10bspfCF z+Cv2XO4d`N9x}4OqdW_aMtz>05B+GAICOx5@6M%m|JmZMIpSHy#b@2!<1#LvX8W9{G{7D6R=MI=Lvq;I#I zA^PF`U)(5pDd%bC>l=9G&FEqN#n?u<(CoYn!|YJ{$hthODB`s%q7x9DU;8PIMpElQ>252U75mH(>#(Z)?wsZIZ>nn*1|b>Dll z$JruPZ|!}b^XAQ)`OVC}TUM^7r`8wK`DaZdnux>_$qhUDg4VGUlM{uG!(TaC=$M!+ zj2|yN-qE)?Vilf@^lj>Uprf~M`{u3N`?ds=Q7gUFZRpt79v?q>Ke%^*`|-jPhYFJ& z*y#RBs|SM%uQ;=6=P?GqBlLRlx7QUfKdr=9sLoW`XN=~urtOq#Dmn4zJ(s;6hkJOh zSJRgbq{niDBJ6OlGgA&E^O?Av%4RHQy4pg7`6u4+@-XOv6vb`BLq2U&t-}@Pyy}!& zK5tMn<%UyB>%pIHUdMmqGn97TsGWeyz6^4hQ zZdp?{p$URee7II%XQ#=w+>W4 zpU6`z17e|dNl_rwaOt^{NP;l{#=8{)!w4D%T*KXRfngL4gJ1~WZGq(iOJ)pBDc4l3 zB$)Q2`TiL=7 z){cj?5G`xQE{NRR2el^@CCB&HU7ZM@h8FVz-`~U6En;Vpy-Ms1vYgoSCyDUKh)f$q zUhF3_r4c#TOymWH$XV>}5Pz(`q#WWO*KZEK)GV|*p?QVI*EX!@uQbPs?OkG9NNo3Q z6FVLdJ2wiwQ|xLIx*~LhU1bk{N)1-GHPW%kLXZciHvWOdm;vvOH=>1n>|BUSKh@D6F z2C*L^`!cbALiRagXO9q>86t9C?iXC{7t?aT_~WAe0vq0h+8{0M;raW%sj{2=5BIHV z{k}I$A^y@V^g02%01dp0-)_I6bj@8_^S)>6Rv%;wBlO49Sqsi|ydc0|*)!1J*9s9m zLvS3_4oA~@!;0Xkg1VKWhhOV#RoQL+>(0&wb{mwcP3KP3via@KOn`K3Ms)Li;TDzM z;YY&jn%H`g`yytfur^BUHh(?5nJT8<5gJCh0SjVTd@yRlfr#=Hsg>V@y1}xeroH%_ z!AQ5H!%eXtr7KeUffz&SoRppyqbNNkr7w#Slt!eK7Q=oNcfbz&b**hD&E6VmYY`@x z*gr^O?+6?_Z1R{Vy9fz+@)t=^^9}*Kym_yVY$PYmh5yLd$ zVzX806%+h&cTa?U3JLs=Qf%AeSw*S+TV|zlPf!1j|C@2YQ&u|Gy>LK%#7&uqc0u&a zo#^p+lpcO^Ljo7)uQseHvO7>hRaUSWS%QRuXi@$Jnb%lxBbCM@sTNfqQ>-|$??EL( za#xDOP1-g<$v&cdalx|>!~~LetC}}OH)`IX7z(l%B$P1+c9zsCvS*0(JWGVpFxa(W zl-Pd~lJrT^AxXU?1c|>x)_x^%t~@bl2ejQ zLKHY{;f{+g1*tqBQIwO?phVFQDQ%W0(xuccQM6o20Wl0w3hbXGvcFLZZ-I)vFEw+} zTY&H@v(5@FMNYH3geEt*nI56ZJ??y)(BwA9{dft(IMZHutB*S6E<_nudbM;HiPR^5o;CrO!0~pu Date: Tue, 4 Feb 2025 17:41:59 -0800 Subject: [PATCH 2/6] Correct handling of ASCENT and DESCENT by FILEDESCRIPTOR not per-CHARSETINFO. Add ability to use mapping of Unicode charcode to unknown XCCS charcode in the private space. --- lispusers/READ-BDF | 210 ++++++++++++++++----------------------- lispusers/READ-BDF.DFASL | Bin 17986 -> 18202 bytes 2 files changed, 83 insertions(+), 127 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 3007b5526..2bfa0a121 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" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT \FONTFACE \FONTFILENAME \FSETOFFSET \FSETWIDTH \FONTSYMBOL -\GETSTREAM \INSTALLCHARSETINFO \PUTBASE BITBLT BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH BLACKSHADE -BLTSHADE BOLD CONDENSED DISPLAY FONTDESCRIPTOR FONTP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC -UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) +"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) -(IL:FILECREATED " 2-Feb-2025 21:19:45" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;17| 39134 +(IL:FILECREATED " 3-Feb-2025 19:21:15" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;28| 36150 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS WRITE-BDF-TO-DISPLAYFONT-FILES GET-GLYPH-LIMITS BDF-TO-CHARSETINFO - GLYPHS-BY-CHARSET READ-GLYPH BDF-TO-FONTDESCRIPTOR PACKFILENAME.STRING - GET-CSET-BITMAP-LIMITS MAKE-CHARSET-BITMAP) + :CHANGES-TO (IL:FUNCTIONS FIXUP-CHARSETINFO BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO + WRITE-BDF-TO-DISPLAYFONT-FILES) (FILE-ENVIRONMENTS "READ-BDF") - (IL:VARS IL:READ-BDFCOMS) - (IL:VARIABLES MAXTHINCHAR NOMAPPINGCHARSET MAXCHARSET) - :PREVIOUS-DATE "23-Sep-2024 12:38:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;1| + :PREVIOUS-DATE " 3-Feb-2025 14:29:22" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;22| ) @@ -24,7 +22,8 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (IL:RPAQQ IL:READ-BDFCOMS ((IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH) (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH) + (IL:FUNCTIONS FIXUP-CHARSETINFO PACKFILENAME.STRING READ-BDF + READ-DELIMITED-LIST-FROM-STRING READ-GLYPH) (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-GLYPH-LIMITS GLYPHS-BY-CHARSET SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP) @@ -58,6 +57,37 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) +(DEFUN FIXUP-CHARSETINFO (CSINFO ASCENT DESCENT SLUGWIDTH) + (IL:* IL:\; "Edited 3-Feb-2025 19:19 by mth") + (LET* ((CSASCENT (IL:|fetch| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO)) + (CSDESCENT (IL:|fetch| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO)) + (WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) + (BMAP (IL:|fetch| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO)) + (AMARGIN (- ASCENT CSASCENT)) + (DMARGIN (- DESCENT CSDESCENT)) + NEWBMAP) + (SETQ NEWBMAP (BITMAPCREATE (+ (BITMAPWIDTH BMAP) + SLUGWIDTH) + (+ ASCENT DESCENT) + 1)) + (BITBLT BMAP 0 0 NEWBMAP 0 DMARGIN (BITMAPWIDTH BMAP) + (BITMAPHEIGHT BMAP) + 'INPUT + 'IL:REPLACE) + (BLTSHADE BLACKSHADE NEWBMAP (1+ (BITMAPWIDTH BMAP)) + 0 + (1- SLUGWIDTH) + (+ ASCENT DESCENT) + 'IL:REPLACE) + (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| NEWBMAP) + (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT) + (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT) + (LOOP :FOR I :FROM 0 :TO (+ MAXTHINCHAR 2) + :WHEN + (ZEROP (\\FGETWIDTH WIDTHS I)) + :DO + (\\FSETWIDTH WIDTHS I 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 @@ -260,7 +290,7 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) GLYPH)) (DEFUN BDF-TO-CHARSETINFO (FONT CSET &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) - (IL:* IL:\; "Edited 2-Feb-2025 21:07 by mth") + (IL:* IL:\; "Edited 3-Feb-2025 16:02 by mth") (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") (LET (GBCS CSGLYPHS CSLIMITS) (UNLESS (AND (INTEGERP CSET) @@ -294,7 +324,7 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (LASTCHAR MOST-NEGATIVE-FIXNUM) (CSINFO (IL:|create| CHARSETINFO)) (DLEFT 0) - AVGCHARWIDTH GLYPHS-LIMITS BMAP SLUGOFFSET OFFSETS HEIGHT WIDTHS) + GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) (SETQ GLYPHS-LIMITS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((XCODE (CAR XGL)) (GL (CDR XGL)) @@ -315,23 +345,21 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (SETQ ASCENT (MAX ASCENT ASC)) (SETQ DESCENT (MAX DESCENT DSC)) GLIMITS))) - (SETQ SLUGOFFSET TOTAL-WIDTH) - (SETQ AVGCHARWIDTH (ROUND (/ TOTAL-WIDTH (LENGTH GLYPHS-LIMITS)))) - (INCF TOTAL-WIDTH AVGCHARWIDTH) (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 slug offset") + (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 - SLUGOFFSET)) + TOTAL-WIDTH)) (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) - (IL:* IL:|;;| "Initialize the widths to AVGCHARWIDTH, the width of the slug") + (IL:* IL:|;;| + "Initialize the widths to 0, the width of the slug will be set in FIXUP-CHARSETINFO") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I - AVGCHARWIDTH)) + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I 0)) (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. ") @@ -340,10 +368,6 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (SETQ HEIGHT (+ ASCENT DESCENT)) (SETQ BMAP (BITMAPCREATE TOTAL-WIDTH HEIGHT 1)) - (BLTSHADE BLACKSHADE BMAP (1+ SLUGOFFSET) - 0 - (1- AVGCHARWIDTH) - HEIGHT) (LOOP :FOR GLIM :IN GLYPHS-LIMITS :WITH GL :WITH GLBM :WITH GLW :WITH XCODE :DO (SETQ GL (GLIM-GLYPH GLIM)) (SETQ GLBM (GLYPH-BITMAP GL)) @@ -363,7 +387,7 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) - (IL:* IL:\; "Edited 2-Feb-2025 20:46 by mth") + (IL:* IL:\; "Edited 3-Feb-2025 19:10 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") @@ -381,11 +405,11 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) 'DISPLAY) MAP-UNKNOWN-TO-PRIVATE))) (WHEN (FONTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:FONTPROP FAMILY 'IL:FAMILY) - (OR SIZE (IL:FONTPROP FAMILY 'IL:SIZE)) - (OR FACE (IL:FONTPROP FAMILY 'IL:FACE)) - (OR ROTATION (IL:FONTPROP FAMILY 'IL:ROTATION)) - (OR DEVICE (IL:FONTPROP FAMILY 'IL:DEVICE)) + (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))) (SETQ FAMILY (\\FONTSYMBOL FAMILY)) (UNLESS (AND (INTEGERP SIZE) @@ -403,15 +427,8 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) '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.") + "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.") DEVICE) - ((SETQ DEV (\\GETSTREAM DEVICE 'IL:OUTPUT T)) - (IL:* IL:\; - "T coerces here to primary output") - (IL:|fetch| (IL:IMAGEOPS IL:IMFONTCREATE) IL:|of| (IL:|fetch| (STREAM - IL:IMAGEOPS - ) - IL:|of| DEV))) ((STRINGP DEVICE) (INTERN (STRING-UPCASE DEVICE) "IL")) @@ -434,8 +451,17 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) MAXCHARSET) (SETQ CSINFO (BDF-TO-CHARSETINFO GBCS CSET)) (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) - (LIST CSET)))) - (RETURN (VALUES FONTDESC CHARSETS (ASSOC NOMAPPINGCHARSET GBCS :TEST #'=)))))) + (LIST (CONS CSET CSINFO))))) + (SETQ CHARSETS (LOOP :FOR CSP :IN CHARSETS :WITH ASCENT = (FONTPROP FONTDESC + 'IL:ASCENT) + :WITH DESCENT = (FONTPROP FONTDESC 'IL:DESCENT) + :WITH SLUGWIDTH = (1+ (\\AVGCHARWIDTH FONTDESC)) + :COLLECT + (PROGN (FIXUP-CHARSETINFO (CDR CSP) + ASCENT DESCENT SLUGWIDTH) + (CAR CSP)))) + (ASSOC NOMAPPINGCHARSET GBCS :TEST #'EQ) + (RETURN (VALUES FONTDESC CHARSETS))))) (DEFUN GET-GLYPH-LIMITS (GLYPH) (IL:* IL:\; "Edited 2-Feb-2025 21:07 by mth") (IL:* IL:\; "Edited 29-Jan-2025 16:28 by mth") @@ -521,81 +547,9 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &OPTIONAL MAP-UNKNOWN-TO-PRIVATE FAMILY SIZE FACE ROTATION DEVICE) - (IL:* IL:\; "Edited 2-Feb-2025 21:19 by mth") + (IL:* IL:\; "Edited 3-Feb-2025 15:50 by mth") (UNLESS (TYPEP BDFONT 'BDF-FONT) (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) - (WHEN NIL - - (IL:* IL:|;;| " older form:") - - (LET (FONT-NAME WEIGHT SLANT EXPANSION PIXEL-SIZE POINT-SIZE) - (SETQ FONT-NAME (SPLIT-FONT-NAME (BF-NAME BDFONT))) - (IL:* IL:\; "Parse as XLFD format") - (POP FONT-NAME) (IL:* IL:\; "Don't need FOUNDRY") - (UNLESS FAMILY - (SETQ FAMILY (REMOVE #\Space (POP FONT-NAME) - :TEST - #'CHAR=))) - (SETQ WEIGHT (POP FONT-NAME)) - (SETQ SLANT (POP FONT-NAME)) - (SETQ EXPANSION (POP FONT-NAME)) - (UNLESS FACE - (SETQ WEIGHT (OR (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 (CDR (ASSOC (STRING-UPCASE SLANT) - '(("R" . REGULAR) - ("I" . ITALIC) - ("O" . ITALIC)))) - 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") - (IL:* IL:\; "Ignore others") - (SETQ EXPANSION (OR (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) - '((#\R . REGULAR) - (#\N . REGULAR) - (#\B . BOLD) - (#\S . CONDENSED) - (#\C . CONDENSED)))) - '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 FACE (LIST WEIGHT SLANT EXPANSION))) - (POP FONT-NAME) (IL:* IL:\; "Don't need ADD_STYLE_NAME") - (SETQ PIXEL-SIZE (POP FONT-NAME)) - (WHEN (ZEROP (LENGTH PIXEL-SIZE)) - (SETQ PIXEL-SIZE NIL)) - (SETQ POINT-SIZE (POP FONT-NAME)) - (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))) - - (IL:* IL:|;;| "Don't need the rest of FONT-NAME ") - - (UNLESS SIZE - (SETQ SIZE (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) - POINT-SIZE - (FIRST (BF-SIZE BDFONT))))) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPEDGLYPHS) - (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE - MAP-UNKNOWN-TO-PRIVATE) - (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS - (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (\\FONTFILENAME FAMILY SIZE FACE - "DISPLAYFONT" CS)))) - (VALUES FONTDESC CSETS UNMAPPEDGLYPHS)))) (DESTRUCTURING-BIND (FOUNDRY FN-FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME PIXEL-SIZE POINT-SIZE) (SPLIT-FONT-NAME (BF-NAME BDFONT)) (IL:* IL:\; "Parse as XLFD format") @@ -663,23 +617,25 @@ UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) READTABLE "XCL" BASE 10) (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") (:EXPORT "READ-BDF" "WRITE-BDF-TO-DISPLAYFONT-FILES") - (:IMPORT \\FONTFACE \\FONTFILENAME \\FSETOFFSET - \\FSETWIDTH \\FONTSYMBOL \\GETSTREAM + (:IMPORT \\AVGCHARWIDTH \\FGETWIDTH \\FONTFACE + \\FONTFILENAME \\FSETOFFSET \\FSETWIDTH + \\FONTSYMBOL \\GETSTREAM \\INSTALLCHARSETINFO \\PUTBASE BITBLT BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH - BLACKSHADE BLTSHADE BOLD CONDENSED DISPLAY - FONTDESCRIPTOR FONTP INPUT ITALIC LIGHT - LRSH MEDIUM REGULAR TCONC UTOXCODE - UTOXCODE? WRITESTRIKEFONTFILE)) + BLACKSHADE BLTSHADE BOLD CONDENSED + CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP + FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM + REGULAR TCONC UTOXCODE UTOXCODE? + WRITESTRIKEFONTFILE)) :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 (2544 3969 (PACKFILENAME.STRING 2544 . 3969)) (3971 9155 (READ-BDF 3971 . 9155)) ( -9157 9480 (READ-DELIMITED-LIST-FROM-STRING 9157 . 9480)) (9482 15064 (READ-GLYPH 9482 . 15064)) (15066 - 21132 (BDF-TO-CHARSETINFO 15066 . 21132)) (21134 25644 (BDF-TO-FONTDESCRIPTOR 21134 . 25644)) (25646 -26243 (GET-GLYPH-LIMITS 25646 . 26243)) (26245 29272 (GLYPHS-BY-CHARSET 26245 . 29272)) (29274 29637 ( -SPLIT-FONT-NAME 29274 . 29637)) (29639 37829 (WRITE-BDF-TO-DISPLAYFONT-FILES 29639 . 37829))))) + (IL:FILEMAP (NIL (2395 4016 (FIXUP-CHARSETINFO 2395 . 4016)) (4018 5443 (PACKFILENAME.STRING 4018 . +5443)) (5445 10629 (READ-BDF 5445 . 10629)) (10631 10954 (READ-DELIMITED-LIST-FROM-STRING 10631 . +10954)) (10956 16538 (READ-GLYPH 10956 . 16538)) (16540 22257 (BDF-TO-CHARSETINFO 16540 . 22257)) ( +22259 26719 (BDF-TO-FONTDESCRIPTOR 22259 . 26719)) (26721 27318 (GET-GLYPH-LIMITS 26721 . 27318)) ( +27320 30347 (GLYPHS-BY-CHARSET 27320 . 30347)) (30349 30712 (SPLIT-FONT-NAME 30349 . 30712)) (30714 +34725 (WRITE-BDF-TO-DISPLAYFONT-FILES 30714 . 34725))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index e0cae104e07ca50d1e9637857d02693393bc3c60..bdcb220706fa445228be09bf82f1c654221637e1 100644 GIT binary patch delta 7350 zcma)B4RBP)k$&^ETCG+;2ubK4v62=c$y$Ma00TC#yLv)z|K56cB@hVK*v1Hf!N!;~ zF=iLa=QxQDBgTjwFgXm^DWBs6PM0emHYgWg#lJY%7QS5SsuC`o@kHDPM8j zJ#SZFJ9TH_*Zscf>FMd|o}PL8lM#08AUiaucHB9-p{%FV)wAh7SI2^mg^uoVv1EhC8wsGek2X<*q_c?dIo3+%Z z4vkp#VAzPnQb$G#2HpLuyuI$oYP~zw3xIvFXO$MCH=e70nxBV_Q7xv2dJO)#+HAA+ z7@=4=VvNts3bXv))ZvlrRe^zUuju6uS>_}V$P2pH#Cr7*b`=N|g^Zv(9M(fL6lepK zTVb@^p1zPbrW>IsNX_ig*Yt&5w+u*~OTuoizef*fA$L$~i^d|Lh8k=U&E4(tbobEP z9D3vbWvOn%A?@^PT9)EDA_8DB2)km&?L+Xpv#ZL)4nO53x`%CK!l zG#t=lE}Xjy?SQ6Z*$u3hU(7yOtL3FQOFgHiMoJxDT`4|nT>{IFQT~&k5BW)iiOUEo>i0LpfXG73iv1|Z0Mnw79l_t`-oahYQp%E2?=zYl1X9r@(rF(i~jfRa!(*Wv{28R{``QKc(Gd>OXRu{=YOOZ*!n2IhNcnWuFG2 zTu_(sYI^*mX^C%|5*c5cDpF~IXF$N7QGq@;B}7`{Tc*VHs+bbT(h}b`C2*-aO^8pWNFgVlG_mH zit;=O92);HZx3UKxWC}l&Ak}fR|)@TWZxq86J%c{_6o9`*vUOaK8_RlNF(y$Vj`F4 z68TvPkq;P=OX(p`@p$1=>=eIN*lGVoiO>s#ZV@`Ko3TCNX%>6(#W$==#1ma&?|k8F z5Kk5h9}_;z`D{#JpCa?pXQsN(Om&~t#33^wU$dvP6LXU+cvkqpdxeyns{)x#3>CvJ zy~b-Kx*;irAK#|)%Ic1KwGeK}5cl1h`9ca$B$FxJ-u0jhb~u8rgH&EdIc5~WF92NV zHNpe1fo2A#EQ3kO47#C+1iJSXxuU;@9(Gawc zA4H>Tp>h>wp@=MSTr#VM=JfVVBJaqFyqi@neEGEa>BzaxKb!d%>^i@={KX(ZDJ8&@G6Y6tOr0je5@jeY6_}M&%CWiTF3QS5qEJdq&oiwpz2&nCkb)qF0dL*) zr6basDyL=A`+g#=D82EsDiA8TRngb%{j7Rg=+AEdtY%thx>%dDYcy?2u-PC50gHyq zr7WTOVErilTVnf={TZ<_WPe0#6xrj%Mv&c) ztn$fbB3H;!%A~A?AIn2VPPiF;}`=8#SIsWXJZ;2#PSa=$S6 z7uBm18G#}ZX7I0US|AMDcGNUyVx<*~Qr@Amv$&>Oy7l=M!z zJ(FAWkbT29JRBJIOI$uTBaRQgugjL$e)DEP;#((&y<4w9PZB7Aomx@M5d)=GlXG86 zTj9BsH!*x6xSg@7(X$o9dhqhw%FUBc1NB}~CW2chFPyzL1P7le7;iBn!jc-XdZTzd z1BPnbgRxYmj>G;R4fL&|+L*IPG;R{kwW7`^8oGsZv8ZnqPCKs7bD|l^w_+ctABpc< zi9|Ww2?t!8UmI9$M7qPW@a!!oiM^I5p)LEKJ|m`WAtbp}65dj~A8twCuWibU(LTv` zGZEvztgT{w{7<#7u)gt^=De4+@^NqjgCxlD28<}&p|IXz$;-pLnpbmmELqY~4pw9Z zVW7Nzcc4#;!r3H>ah_EnR`YWW73?^Fx51fz93WLr^hy4w2E&Gcazym=dz`b_3BK7m zuk2(KP3cfQS$VRO$Z>wg*-5FTej#+!@*@b`Y`Vh=%sBNB!R+S%&wyZ#;N3ZM-2nmi zmK1n{v>!v{6^WcAgob%mB2N*LLYYS;GK5IAaulJ}5(<#e7$VEy*!jrZ%5F;iIkLHw znh!&>@}Gn#7YTU|kyj;h3XHYjU03wx0<7LhjV$FG8%xHo&V7b$IHH1T?8C;s?DEb9 z3l`f@(RZnxy!bS+`}Wc(r`O_*M_#qUJ=F4Ivm~>KoZ)ZHJI%)U)~216cp`;EC0vg} zv3@NQh3^ESw=^~4;#cRDa(nYm&uehlQK%o9l4NuaVCR{Iu-6quPeGOM?onxU_9lb4 zwhxA5k>0+LzkSj3u)r6aA7}l1am(Ec|GFFF1jh5aVMO?U1!_@F7o!>O$f~{|*x}M5 z5x8kS&e~-of4QZ#?FgN@{)|W37iLwHIme`Rr+C&Ki0?Fvq-u>(xQ({HFBy zKRqv2k3V)tRu)^$_q1scz7uVZ#0eN$m2Ui7WM!hAM1%etjJLs=UJu}zC=a1)r10O6 zeN)r}QGQJbt=5OgDyQ-BlWFw(f=b4VguH-_&l8ISD}N;|Jcax-1fPDA$Vu7Y?5DTy zc1zMBi9?b?Nu1DG{Tyt~(L&wwyAdM45`KPu{#}Vr;f4JjiMAknTKJKSN%D*&Pe`&8 zw7`K5zBZu9CJC;`z6xbmSR%cIkjiBe=_G`*t5G7ggd9DP07Ww;luHn1moi0&a-DR{ zMdUq+jDrQal^DOc*9_jkjiaTf8mJ8;zxEhIf`i6*8RvGc_9AZ#XZ6 z4CmBnC;{w6pV2ZIUvS=Uv`&rs_ZzLR2aL9<(ZGJA?G2-;5v(&DD%f}K<|d;?jTcWC zg=B#rN}tIFp!S*UJ8HaaVmMwiVbsV{SZb6RHJ5!*1C5%klhAPXH)&BNo~ZhgY!%23 ze~qkBRce{=2PWec6F#Ft*7A7igi#C%hrmR1-Viy_3A7Q$ns#Iji`Pn@squQrl!2%L z;8IvG@Fe)xlu)p*V|dsoHHr*VxOg&Q+- zH^qy<1{JJBw@HT?rEqL83XAX*Fi;6)Z2A;H`*mu>;>GW35I%5$yxLW{G#?}BRZ)lJ zglIrACMesMlhj^Bs%aZwC1M@CDSwm=e8a-p#MHg?a@;Kj+axy&JNzr16x8n#vMoFsR;<|j% zZ20ywxM*4VS~D@u$ge}A?&Q#^bL!am4;I;2@j~r^&XvDEs%`oG=+J>J$)Up<|7`J3 zVF&%;oet*Um+!1d7{ygXRmmX;JXp4}%84MY{e_Tv@$8v^`ufmN)!+qxyl`UZVy{f0 zq6w2JHW>&^2&O`69X(rT6tauKkP1s#Y?S7MSCxqnYrJ3-s-WfUzktqOzmuu7l56vM z(~@qvV2Nt<*f#~9z}1~{C6Ikk;88|h4+Sg_E3^4|0x|rKZ%0gi+CWI2q@F~!PRv14 zDh7bC&oUa>2VxMB3xrG|8xxfWoIo{Dm_Mio0@^BfpbaV?Hp+0>hin(0v2<3Vl{%h7 zz=o`v1rOy0p;StKDrO@xA=V;!O}LP}EXgrRz9U?Fg=@QL-7MDPNrMf-(6cOA=@~}! zFnlYF4TLp}T;>Hd@aY8B|NgMnXTh{mu)uIWdkt%1w{TlAmx(+3?g>gpIPoA;cpdwr|{)X*m~Z# zVjVost*Dyy!ku7{Eo?+}{LO_5v0BN0wW6Y2t;64ivZ-jPH3wbxgDxoX8^&j>tXJ6v z-r<=m!;?Sa=}0U_Q@HHCyMpqJx z2MS1Zd?KrSfUHWllXJvccFDc0`F@y+HKGNLevK5Wl{I3$JWU+uUT7 zbS`GZ)`(6-O2j-Q7SYKMc`F(aQ~pMD(1%}j=>Uz_LYt{tH%sUcYy3TLeWDY7b2%6i zL_A_1zC}e760c}N9e_VMQ+79lBMbTMBdhM12cC*aEk_K1iMBtc0+l9)=nrS5=O z5IX3v!H-L!9lIPG9ei8&BNk7Q@bIhMbxsX`Mk~dyVfYi7OAGbu5hH{rRVFkBzam-0 zQr@VoVf8$r-L*k^ iA)jP8iY?qnmzSu*;G&f!H1QCiYRI5-mAd8T&Hn|>k;Y2^ delta 7172 zcma)B3v`snb^hnyhu%U+LJuUQMF>d-aG%U zz>m}FvG@Mpd~;{!&b{;a_mK(q@;E!TQSV+lxw*>Mqi; z1EC0y#zmX{j+kRle_y3PrO_jOd6K@v;dP9X=vbsya*43<3^MKT^=B5HKiS! zJvnZ5LwED2B;PD4G-a_VOHEluGAWI66R4C2s-Zo30Dsd$mk)r6n}5M>4RltI#H0bP zC<(a+4D>d6181rTP^g0h9bC5!Djv&Vx z48-Cod7sHJ2X8VaQe^C#DS1DXmx6^`U1HLXYU!k~fU!KBX}=NG^ps3OjS{Gl^BHA@ zYWY~sE{-T=GH-FFX?iksP;n0esQ}F7JZutj<7AfcHIp$tZHm#Vow{XAUpG6GozavkeMq>AS}Pt+pVIQzz5+wn$~5xu zqvGPsT4soER=2Y~;-#W3HAXSzlBPXo&iW}0e8uh%MK!CZ?k(|yc!lC#^q=)t#$ z^AD(AAoU8WXGy(`sv!0C10*gbNL(~X{Cp{i*XEP>Sp|uos#tq9+x+9=Z%ZF!j|*c) zZ{Zsi(kPLJRT|~NoIG&JVsb0 zW}eqDAIL%)lL*%FKq!|+Z$srGf6!biF^!1%7{H|-9vOv|G`EaWYT1(6aCt|~*@(W;+`$Z;L?rJ?w4qQu!=)LA+VM&gor+RhWGd3ENx}))^!$6l_e-*8V^Q zD@ND{;>n7}@_({66Q`g;`bs1OjSqruNAlAF=cj=4GwH{GE5?BHn*rxH1I}*-oZk#M zzq!-+&7HxwJUT|&AbGt{l&)22)6t{ac_h5(J6wV`N zL{sdmoh2LmtP$%|mu?CCLNoB`xI;k?o>Y@OuA=5N36`7*1|aBxc`Hrea`aEs-{U_xWcpQY0{?` zc{bM^U6R!Rt3b73scR~m6=X>CcA9um-vrqN|V}1R`JnGXXeTE!h z@P|Y~Hp>CAseX8xP$r=(K?u$qAt)RTbK!9AZukY;F6tVG*e|3sc_~*uhaD?CFXe;8B*=#$LTpV-E zW)X45afU^vhUdO!8Qo_G=fkw+d4fC!2YkFCz~6WgUL-t*v#+naryAU42|+_eL$2VU z5rh3Q7Duc`MnUM;u@6Qx%IWF5)PV_c-~8s{2`r8iut%Jk&l?cXPD+~X!%)p08+6Bv z_4g6wn5b!KtrBhcpgr6~n5ZQ&AqHD|DPHtHN&~Gv2eVajsT+lfe`IQLXIMGRv}M-5i1&z-U5L2_tN9b1H10ta>w@D#jCBwQ^#8m zv(1NfFp5>#L!X_no~8L{?=+Q@!@o}Io%d5?r#FD#^VE$Y;-ixE0wrdV_=dQ5!ME5$ zqP~4^EnaZom;|T&aD2#!#^8!8y_M;4r+BHgLcGwv&wYkLTT~Cbl47*)v9rud*bg)< zfY%zYPp8(|^9-(mg&QOB=(@r1K=+czc zG;K1jsDCg7{cuvK$$hL_6^acV9i4}v8(-*=-o=(W>dq0>yOZMCj-@O9&z>($k26Q> z#3p?sReoOC|LezObgIQ^v9PFU?=skg*wf{xJ_h~Nl^dT#Ri&vAPj$^nz5xJxMLKXO zza>*ND_2za5q)_Y{k}?$CkerzREIZ)4QNLQ#o*NrlX~g_5<>N`afqHKy-M^b(dJOH zREcJ&t^Xe8HO~lp)vFCeek1*2XZOnFFX4ebOVs(OeoOjMoKoVj689;w7p%ZR1uo4< z*{Z-zSXZM2izs9rA(UV%6w*rwC0L6>8VEUl2<~@mrh*Cx!UWT<6QcbGB8>d_nnI?a z2L+VwY9w450jhRol{D0DaCxCL)Q0eStu)lN=TaVCy3q1PD}3sk)8h+Nl8FngCE}T$ zhYI3qo3L~UZ|@# zX8IE~nSNeLy(z@LsD70LSbjC(ctQNC&yk#+*^zK$xMLS%*C(Hz#b>sBV^&r3S4T z>=}G><_nDA_R7u@3wI3m9a3>&V0Cf`gmxomLVFe}6>W3{gWThW{{bw9+Xm*>yMIcw z36~u1RN5>kwamd9H@$KMOuq(LUet<^`zXe=FM&zDU`pzpTU$qz}O-lu#>$endUd z8qKa@xeeR$kXFesCE77S$6I>2AFP#IgQSM*5qIyszs{S?g zqGi&R8hhfLe$UjUrTMI9(73&K?T6nmwtqM|c4&KQ?6~o?-`EDO(6&k!GvK@@)jjpgHc1t$uyek*5 zA+c-aHa=tnz|34Y`>HPj)UL0+JqJu$T<%!@AdSY(N!VzcVb&$m-y!|Y(qAOu1q5A| zhNqfWU0`fj{C;(fnt9Q%rl=VwlYJSCSz|B|e4w3@eS~V5jD93GteNLlNSW-y0(G<^ zzrRn2_A{bl1ZYpnE@fl4OVwXun#rsQmy`O*Zt0ImW2Nlrmfd3R+CDZShSvT`*N7Et zPmh@1id)@O<;0hukNFWE3*Z+T>J0Ibcx!DnMIzpwL0#+Z0ReZlYgB-eywYKs7pzt|j#t zqN-!4YP5pr7#G?(BK*&OwXn{+4Z|U7g!qu541QEEM@oq^A-vwX9TfO`2zV2%svID- zUM@nULeeqFDi?`KZ_PZ!wC~AIdc&&sjbc^3SuOCN%#sF#m-xB2DY*!~@R$fo5^gyk zpJK8Fg-5oajpyMV6MiW&4&y@>C;_=pDO@f@%H!}Z0c%8MCyI~~VI@qXUS&HdJHiu= zeE4Q3ynDZ6i$naGac5w4nOtpiz?2nxcqjs2NICIasX9tnP%xRQq{|M^mH6%o3!O%I zC=lggJZCfMV(|5jRW1>&z7f_SQofbd(5X{e^={~$IzVKUDs0x~pgt2#L$2Xc5TjeC up3ro9OXq^30(|Wh4fxl^@zMf&T9}6oxNcgcOOC;_9_HF3=+A98Zu~C~FOy*a From 598bd7037cccdc933c41c0ac6453607221f5f419 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 4 Feb 2025 17:44:11 -0800 Subject: [PATCH 3/6] Create 2nd FONTDESCRIPTOR for unmapped Unicode to XCCS charcodes, organized by charset-like (8-bit splitting of charcode) of Unicode encoding value. Needs more testing! --- lispusers/READ-BDF | 201 ++++++++++++++++++++++++--------------- lispusers/READ-BDF.DFASL | Bin 18202 -> 19321 bytes 2 files changed, 123 insertions(+), 78 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 2bfa0a121..9f5b6c919 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,15 +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 " 3-Feb-2025 19:21:15" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;28| 36150 +(IL:FILECREATED " 3-Feb-2025 23:18:20" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;29| 39881 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS FIXUP-CHARSETINFO BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO + :CHANGES-TO (IL:FUNCTIONS GLYPHS-BY-CHARSET BDF-TO-FONTDESCRIPTOR WRITE-BDF-TO-DISPLAYFONT-FILES) - (FILE-ENVIRONMENTS "READ-BDF") - :PREVIOUS-DATE " 3-Feb-2025 14:29:22" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;22| + :PREVIOUS-DATE " 3-Feb-2025 19:21:15" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;28| ) @@ -387,11 +386,11 @@ 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) - (IL:* IL:\; "Edited 3-Feb-2025 19:10 by mth") + (IL:* IL:\; "Edited 3-Feb-2025 23:12 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 (FONTDESC DEV GBCS CHARSETS) + (PROG (FONTDESC DEV GBCS GBCSL CHARSETS) (WHEN (LISTP FAMILY) (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY) (OR (SECOND FAMILY) @@ -434,34 +433,48 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST "IL")) (T (IL:\\ILLEGAL.ARG DEVICE)))) (SETQ FACE (\\FONTFACE FACE NIL DEV)) - (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 GBCS (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE)) - (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)) - (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) - (LIST (CONS CSET CSINFO))))) - (SETQ CHARSETS (LOOP :FOR CSP :IN CHARSETS :WITH ASCENT = (FONTPROP FONTDESC - 'IL:ASCENT) - :WITH DESCENT = (FONTPROP FONTDESC 'IL:DESCENT) - :WITH SLUGWIDTH = (1+ (\\AVGCHARWIDTH FONTDESC)) - :COLLECT - (PROGN (FIXUP-CHARSETINFO (CDR CSP) - ASCENT DESCENT SLUGWIDTH) - (CAR CSP)))) - (ASSOC NOMAPPINGCHARSET GBCS :TEST #'EQ) - (RETURN (VALUES FONTDESC CHARSETS))))) + (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE)) + (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)) + (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) + (LIST (CONS CSET CSINFO))))) + (SETQ CHARSETS (LOOP :FOR CSP :IN CHARSETS :WITH ASCENT = + (FONTPROP FONTDESC 'IL:ASCENT) + :WITH DESCENT = (FONTPROP FONTDESC + 'IL:DESCENT) + :WITH SLUGWIDTH = (1+ (\\AVGCHARWIDTH + FONTDESC)) + :COLLECT + (PROGN (FIXUP-CHARSETINFO (CDR CSP) + ASCENT DESCENT SLUGWIDTH) + (CAR CSP))))) + (LIST FONTDESC CHARSETS)))) + T + (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) + FAMILY) + (GBCS-TO-FONTDESC (SECOND GBCSL) + (\\FONTSYMBOL (CONCATENATE 'STRING (SYMBOL-NAME + FAMILY) + "-UNMAPPED"))) + (LIST (ASSOC NOMAPPINGCHARSET GBCS :TEST #'EQ))))))))) (DEFUN GET-GLYPH-LIMITS (GLYPH) (IL:* IL:\; "Edited 2-Feb-2025 21:07 by mth") (IL:* IL:\; "Edited 29-Jan-2025 16:28 by mth") @@ -475,6 +488,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (MAKE-GL-LIMITS :WIDTH GWIDTH :ASCENT ASCENT :DESCENT DESCENT))) (DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 3-Feb-2025 23:00 by mth") (IL:* IL:\; "Edited 2-Feb-2025 20:29 by mth") (IL:* IL:\; "Edited 28-Jan-2025 23:09 by mth") (IL:* IL:\; "Edited 27-Jan-2025 17:22 by mth") @@ -485,40 +499,50 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (UTOXFN (IF MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE #'UTOXCODE?)) - ENC XCODE CS XCS) - (LOOP :FOR GL :IN (BF-GLYPHS FONT) - :DO - (SETQ XCS NIL) - (SETQ ENC (GLYPH-ENCODING GL)) - (SETQ XCODE (FUNCALL UTOXFN ENC)) - (COND - ((NULL XCODE) - - (IL:* IL:|;;| "These assoc with the Unicode encoding") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((AND (INTEGERP XCODE) - (<= 0 XCODE 65535)) - - (IL:* IL:|;;| "These assoc with the 8 bit character code within the charset") - - (TCONC (AREF CSETS (LRSH XCODE 8)) - (CONS (LOGAND XCODE 255) - GL))) - ((LISTP XCODE) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset (like above)") - - (LOOP :FOR XC :IN XCODE :UNLESS (MEMBER (SETQ CS (LRSH XC 8)) - XCS) - :DO - (PUSH CS XCS) - (TCONC (AREF CSETS CS) - (CONS (LOGAND XC 255) - GL)))) - (T (ERROR "Invalid XCODE: ~A~%")))) + NOMAPPINGCSETS ENC XCODE CS XCS) + (UNLESS MAP-UNKNOWN-TO-PRIVATE + (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) + :DO + (SETQ XCS NIL) + (SETQ ENC (GLYPH-ENCODING GL)) + (SETQ XCODE (FUNCALL UTOXFN ENC)) + (COND + ((NULL XCODE) + + (IL:* IL:|;;| "These assoc with the Unicode encoding") + + (COND + ((> ENC 65535) + + (IL:* IL:|;;| + "Unicode encoding is > xFFFF, put it in the NOMAPPINGCHARSET") + + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) + ((AND (INTEGERP XCODE) + (<= 0 XCODE 65535)) + + (IL:* IL:|;;| "These assoc with the 8 bit character code within the charset") + + (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS)) + ((LISTP XCODE) + + (IL:* IL:|;;| + "These assoc with the 8 bit character code within the charset (like above)") + + (LOOP :FOR XC :IN XCODE :UNLESS (MEMBER (SETQ CS (LRSH XC 8)) + XCS) + :DO + (PUSH CS XCS) + (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS))) + (T (ERROR "Invalid XCODE: ~A~%"))))) (IL:* IL:|;;| "Extract the lists from the TCONC pointers") @@ -532,7 +556,21 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (LET ((CS (AREF CSETS I))) (WHEN CS (LIST (LIST I CS)))))) - CSETS)) + + (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))) (DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) @@ -547,7 +585,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &OPTIONAL MAP-UNKNOWN-TO-PRIVATE FAMILY SIZE FACE ROTATION DEVICE) - (IL:* IL:\; "Edited 3-Feb-2025 15:50 by mth") + (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") (UNLESS (TYPEP BDFONT 'BDF-FONT) (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) (DESTRUCTURING-BIND (FOUNDRY FN-FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME @@ -600,14 +638,21 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ SIZE (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) POINT-SIZE (FIRST (BF-SIZE BDFONT))))) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPEDGLYPHS) + (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE MAP-UNKNOWN-TO-PRIVATE) (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS (PACKFILENAME.STRING :BODY DEST-DIR :NAME (\\FONTFILENAME FAMILY SIZE FACE "DISPLAYFONT" CS)))) - (VALUES FONTDESC CSETS UNMAPPEDGLYPHS)))) + (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE + UNMAPPED-FONTDESC CS + (PACKFILENAME.STRING :BODY DEST-DIR :NAME + (\\FONTFILENAME (FONTPROP + UNMAPPED-FONTDESC + 'IL:FAMILY) + SIZE FACE "DISPLAYFONT" CS)))) + (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILESLOAD (IL:LOADCOMP) @@ -632,10 +677,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 (2395 4016 (FIXUP-CHARSETINFO 2395 . 4016)) (4018 5443 (PACKFILENAME.STRING 4018 . -5443)) (5445 10629 (READ-BDF 5445 . 10629)) (10631 10954 (READ-DELIMITED-LIST-FROM-STRING 10631 . -10954)) (10956 16538 (READ-GLYPH 10956 . 16538)) (16540 22257 (BDF-TO-CHARSETINFO 16540 . 22257)) ( -22259 26719 (BDF-TO-FONTDESCRIPTOR 22259 . 26719)) (26721 27318 (GET-GLYPH-LIMITS 26721 . 27318)) ( -27320 30347 (GLYPHS-BY-CHARSET 27320 . 30347)) (30349 30712 (SPLIT-FONT-NAME 30349 . 30712)) (30714 -34725 (WRITE-BDF-TO-DISPLAYFONT-FILES 30714 . 34725))))) + (IL:FILEMAP (NIL (2327 3948 (FIXUP-CHARSETINFO 2327 . 3948)) (3950 5375 (PACKFILENAME.STRING 3950 . +5375)) (5377 10561 (READ-BDF 5377 . 10561)) (10563 10886 (READ-DELIMITED-LIST-FROM-STRING 10563 . +10886)) (10888 16470 (READ-GLYPH 10888 . 16470)) (16472 22189 (BDF-TO-CHARSETINFO 16472 . 22189)) ( +22191 28138 (BDF-TO-FONTDESCRIPTOR 22191 . 28138)) (28140 28737 (GET-GLYPH-LIMITS 28140 . 28737)) ( +28739 33380 (GLYPHS-BY-CHARSET 28739 . 33380)) (33382 33745 (SPLIT-FONT-NAME 33382 . 33745)) (33747 +38456 (WRITE-BDF-TO-DISPLAYFONT-FILES 33747 . 38456))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index bdcb220706fa445228be09bf82f1c654221637e1..c1cfbb366a7d18f64c22d40146468ccd29fbc12c 100644 GIT binary patch delta 3157 zcmb7GZ){sv6@T~INt&cJZ;qR`QL|=gnzg}>nl3F(T2jB*FY&XVeLdU#<1~#|b!;zx z2omCtU=W9@WmDyC^&TyL8(Xzih<;$gNg!KVCl3Tnick@BL+lHPX;gebNJ#xup(>nn zp3_kA1uXfU-~GLFfA`#b&pr3O{tCN)m0do=`if&uY&!5%f6w9m1N)0F`qy#K+^zdH z>y7e zEA?pR$ASvc4cG!@=qO!!grX51rAXd9d)R*(yq{{r0IT7`*wVy3Y`jS^L6ekih-ZE` zJRI-W0Zlvrzw^-bC(xi^?28jHd$+C98kip)K9VN{Gc+QrwT%?w10T18LnOMSF=dK7 z;{-I$Xd=$Mh@=jr{LpKfNk+5LLfz@nQOjgQmaGw%B-L52lF3Turc$AHFgzp@8S{ny zXucVD?QZExp>8x05{b|OZ2!fACuazMW3{6B02%f>d{j!W78=vp_@K}O2_>!~_qH{P z=8Clg%?!wG9@TVR9ai*iB{huX*GXXp;TJ(+OFEO%62tkx@nlFzlgJmyV-7uzAmlED z&BVR|Q2IN?BK_4G!PcLw0Gi)A=9Xh_IOd9DUbOt^GHZ?0gJp{-C0$2&!RkW%aUMdg z4XY<0-Lbt2%}pthQ8JoHAh8I9dq{EKUdKjS8zI-r*mFpUYkKw@R@Y;e=0@FLlnV8M zX%mSeilXU8j3Ym*<3QySgUm-U$MaXY?b7%itO!DVB`$a!od zC);t#z+yQQXDfQnYbO}Im=GSw{+EPjYK>0Id|Oa>NC|pqLKYrMUR!uXUT!g3W{sTB z7GB}oVe6zDJN(V9`FeLJcOju2aARbzHc9qTuFBRPA14qT#;Rf7~UMr2J zjW+6A2)A0>&}@cOXv7nRQfeZDoC~-HG5NN+sw(MOZCLv>h`Mx$M-4-4OJ&YA0 zJ1+e6q~;lYXHNRA?i9ak6M7yt{gOVthMSKi@R}~<$drq!mJzVac^yk=&ik71Ueuin z;0Wf9lLghi91&iY^L=_I(ON8TjVD@Ggzpg*;pG_f?@5*V*yYX`4tgyZfkL<#6S7kY z?Uw;YH^zrq!o23zx+ie%GWf!Rq$9uy8S*e9WOHobVBQO9 z)#vm&C_E5EMEDkS%@za*#n(yaW=!Yi9gyJ^8fyDM$7h#65Hf#13Jdn`Bg046hmQ(* z5jV~}H?aS?|2>B2{~N>2h;tgO(aq*R26_~{2l)GxfS93t5^A(N4QYps=b-VKYRMlu zo(NT|BR@$g*p4o7Gk0uzo<}yA`iEkyLhKXZ$KHGBz;0~7w+QY=2Wx{pVf7+&3>k(u z0Ba75Crcv)4`WnyZK3Q2kSEb72L@#E^Jq9 zmd~}bT!$^%d9IV?_S&M8vs{-g+H!t4^xd}bR}X!^@H1@h6y46}4n0F*l}@?n-ckc$ zNL1OYH;A8uM)~JrFLW~iitehED!LiAJB0uFDE4wb`$Pvx(q*(R>;G@rZVr0opFtpP zps-hTb+8)vjvCu;_J+ozSoHb0^*J=p;>_815az5FG)emQ;C_06smhxiSI>rPJ-M<^ z%t|Ob*#|z-9KPi4uaN0G2U%B}Qsd%;Iz~+UPV0=*|BWVej1h}pH9QQrg}eG81_=s{ zK@rZv8+Mjs6UouC12FEv*ivPL>LdVGX|il`LL9NU?=GVU@eS HxwiIi)gN)y delta 2016 zcmYjSZ%h+s7{B+53;~<7o|0BkFvy0X#wsW_}r(sIzNVs4LW-J=gle-cz{ueASCZyLG>^lXO@=t$TT{ z{-yfOwKa(WU6a+|uFlR~bLzH5&oZ-n=gz%zds~jIWJ2w8H(S@$jOMO!r#Ozk)$<(( zpR6=(-YoFf%sb|SdDpxrWzFfaR8~JDd9q{E=4@Y&L?oU7GaZ(AW}KI^^6BFk3%md1Y`W4+yvm14TM z*)i_)^j1${$-AZ*NEQ1_X4>nRX#u`I$6&2y^RF8O*jQS0sF#2*Lj`!7^Hi8vVsAa$ z&`$-H7lIoL0!bs$Cc+D*z}Z8!R-tobY9mVMoSi^; z*M=uKf#y4Q9l~(#>P$^9HIj;&kX0jzToSlys{ zp@3!;n!E=d-0zINf#&yiJ%VEoA>6Tp2w%Ez-GvLb5IkWAC+*f__RwnZla%#Yw|@$) zsJ$Hn=AgMsMLh)LiOXBCtcug5l+>t!#8n_FdL`F;78eO^Nc{k#dZn1A4<50%^R|Y~ zknra2KNPXnmfEf(Ac{PA;Jqal&TTN1{*WqZ3O{ zsW;$GVtzb|)0q~oP~l9}y)3$;WtCF_we>ca&G%A)qiY(~plp!r zZ5V>Ix0Hbm)aM3-3>*XMn@@{2${gmHO%cqWKt+FfE=$x08GKIuA&CDl$URkK9hE|x z1w4nZm`G5rWE8Yjk)Ux@HW{|^(uOHwFgf{=QNX=6uEyvgHK-iKOIk{*I4k79|C0(*lok^N^%4DxX=Oxs$)`A4NCF2G#JQT8lS0|)#6yn!w-C`lw>A+E zoX?18we^i{@j+iavG?NJ{DTdUkMQxA9YA<&E%puew}8nNSa%igF=%-cx~_E3X@oKU zP4=*t#ou5@zKD})NHKPG{ECY(RR*owk;5Ci23f@RB!kBFwg&TBiRJ#B3u!9v8CzQV E4>l@JlmGw# From 6dbc30d1cd04f83650c80344bd0a43361b3ea134 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 4 Feb 2025 22:51:34 -0800 Subject: [PATCH 4/6] A little cleanup. Still needs more testing. --- lispusers/READ-BDF | 29 +++++++++++++++-------------- lispusers/READ-BDF.DFASL | Bin 19321 -> 19372 bytes 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 9f5b6c919..edff62f61 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,14 +5,13 @@ 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 " 3-Feb-2025 23:18:20" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;29| 39881 +(IL:FILECREATED " 4-Feb-2025 22:28:30" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;32| 39958 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS GLYPHS-BY-CHARSET BDF-TO-FONTDESCRIPTOR - WRITE-BDF-TO-DISPLAYFONT-FILES) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR) - :PREVIOUS-DATE " 3-Feb-2025 19:21:15" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;28| + :PREVIOUS-DATE " 3-Feb-2025 23:18:20" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;30| ) @@ -386,11 +385,11 @@ 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) - (IL:* IL:\; "Edited 3-Feb-2025 23:12 by mth") + (IL:* IL:\; "Edited 4-Feb-2025 22:27 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 (FONTDESC DEV GBCS GBCSL CHARSETS) + (PROG (FONTDESC DEV GBCSL CHARSETS) (WHEN (LISTP FAMILY) (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY) (OR (SECOND FAMILY) @@ -467,14 +466,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST ASCENT DESCENT SLUGWIDTH) (CAR CSP))))) (LIST FONTDESC CHARSETS)))) - T (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) FAMILY) (GBCS-TO-FONTDESC (SECOND GBCSL) (\\FONTSYMBOL (CONCATENATE 'STRING (SYMBOL-NAME FAMILY) "-UNMAPPED"))) - (LIST (ASSOC NOMAPPINGCHARSET GBCS :TEST #'EQ))))))))) + (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) + :TEST + #'EQ))))))))) (DEFUN GET-GLYPH-LIMITS (GLYPH) (IL:* IL:\; "Edited 2-Feb-2025 21:07 by mth") (IL:* IL:\; "Edited 29-Jan-2025 16:28 by mth") @@ -676,11 +676,12 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST :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 (2327 3948 (FIXUP-CHARSETINFO 2327 . 3948)) (3950 5375 (PACKFILENAME.STRING 3950 . -5375)) (5377 10561 (READ-BDF 5377 . 10561)) (10563 10886 (READ-DELIMITED-LIST-FROM-STRING 10563 . -10886)) (10888 16470 (READ-GLYPH 10888 . 16470)) (16472 22189 (BDF-TO-CHARSETINFO 16472 . 22189)) ( -22191 28138 (BDF-TO-FONTDESCRIPTOR 22191 . 28138)) (28140 28737 (GET-GLYPH-LIMITS 28140 . 28737)) ( -28739 33380 (GLYPHS-BY-CHARSET 28739 . 33380)) (33382 33745 (SPLIT-FONT-NAME 33382 . 33745)) (33747 -38456 (WRITE-BDF-TO-DISPLAYFONT-FILES 33747 . 38456))))) + (IL:FILEMAP (NIL (2252 3873 (FIXUP-CHARSETINFO 2252 . 3873)) (3875 5300 (PACKFILENAME.STRING 3875 . +5300)) (5302 10486 (READ-BDF 5302 . 10486)) (10488 10811 (READ-DELIMITED-LIST-FROM-STRING 10488 . +10811)) (10813 16395 (READ-GLYPH 10813 . 16395)) (16397 22114 (BDF-TO-CHARSETINFO 16397 . 22114)) ( +22116 28166 (BDF-TO-FONTDESCRIPTOR 22116 . 28166)) (28168 28765 (GET-GLYPH-LIMITS 28168 . 28765)) ( +28767 33408 (GLYPHS-BY-CHARSET 28767 . 33408)) (33410 33773 (SPLIT-FONT-NAME 33410 . 33773)) (33775 +38484 (WRITE-BDF-TO-DISPLAYFONT-FILES 33775 . 38484))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index c1cfbb366a7d18f64c22d40146468ccd29fbc12c..c74d9abef88774648c5c1b515047cc73bdb78e0d 100644 GIT binary patch delta 296 zcmex4jd9I%#tAV@#zqt4#5_!N-BOcujSP%T6^x9mj4Z5-4Y=GKgMAdzGILTDl8aIk zOHxx5LP}GMQxYq66igI=%8N=9iz*dBdUT+gOwBg#e#a_=Y1ri5Y?eTqCSMm;-z>|n zD#vVWY`oc3^*uAQv5CcIbIlAO!_;i^A{}XN#*dTtnaeO<*?il4A0v||S=EYJP)IzV0SGuj#C`~KGAoOU50fBJIY&TfNI;N(Krq`( zpbn-o1}2^vlbL6_0;M>e{R1L{Jl#D)W=v)T@>%@+{ahKrvNLmmd?r7ChFKs@b^reZ E0NUeMVgLXD delta 276 zcmZ28o$=>1#tAV@MwS!f#N3T_-BOcujSP%T6^x9n3@xmT47l7JgMAdzGILTDl8aIk zOHxx5eDm{C5-W8Sj1_>Yi%JuVDiuIlbYOZ6H|}}IDuij)P_3llPm;Fkaq#$9x|nW5(n;mQ{jJXH4y3 zkMVQ%_j5LCVqjo=uvy)TSul_%p8*IsL4*Lqj2;0)g_8UN-JI02)EtGh{Gwct#7yQH slNlQr*?=Z+1cZhJ1o;O9GcYpFn9MxWb!IM5l*!MZVHVI(rmFw{0k-*3-T(jq From 0c59a89b85ea690cbd54cffce0b286f4deacb053 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Wed, 5 Feb 2025 16:30:52 -0800 Subject: [PATCH 5/6] Added option to create and write files for RAW FONTDESCRIPTOR which does NO mapping from Unicode to XCCS. All glyphs are at the Unicode encoding positions. Any glyphs with Unicode encoding > xFFFF are not included in the FONTDESCRIPTOR or DISPLAYFONT files. --- lispusers/READ-BDF | 218 ++++++++++++++++++++++----------------- lispusers/READ-BDF.DFASL | Bin 19372 -> 19863 bytes 2 files changed, 126 insertions(+), 92 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index edff62f61..d94a9a478 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,13 +5,15 @@ 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 " 4-Feb-2025 22:28:30" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;32| 39958 +(IL:FILECREATED " 5-Feb-2025 16:11:53" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;35| 42056 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR WRITE-BDF-TO-DISPLAYFONT-FILES + GET-FAMILY-FACE-SIZE-FROM-NAME GLYPHS-BY-CHARSET) + (IL:VARS IL:READ-BDFCOMS) - :PREVIOUS-DATE " 3-Feb-2025 23:18:20" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;30| + :PREVIOUS-DATE " 4-Feb-2025 22:28:30" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;32| ) @@ -20,8 +22,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:RPAQQ IL:READ-BDFCOMS ((IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH) (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS FIXUP-CHARSETINFO PACKFILENAME.STRING READ-BDF - READ-DELIMITED-LIST-FROM-STRING READ-GLYPH) + (IL:FUNCTIONS FIXUP-CHARSETINFO GET-FAMILY-FACE-SIZE-FROM-NAME PACKFILENAME.STRING + READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH) (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-GLYPH-LIMITS GLYPHS-BY-CHARSET SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP) @@ -86,6 +88,57 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST :DO (\\FSETWIDTH WIDTHS I SLUGWIDTH)))) +(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (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 (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 (CDR (ASSOC (STRING-UPCASE SLANT) + '(("R" . REGULAR) + ("I" . ITALIC) + ("O" . ITALIC)))) + 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") + (IL:* IL:\; "Ignore others") + (SETQ EXPANSION (OR (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) + '((#\R . REGULAR) + (#\N . REGULAR) + (#\B . BOLD) + (#\S . CONDENSED) + (#\C . CONDENSED)))) + '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)))))) + (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 @@ -384,8 +437,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST CSINFO)))) (DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL - MAP-UNKNOWN-TO-PRIVATE) - (IL:* IL:\; "Edited 4-Feb-2025 22:27 by mth") + MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Feb-2025 14:53 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") @@ -432,7 +485,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST "IL")) (T (IL:\\ILLEGAL.ARG DEVICE)))) (SETQ FACE (\\FONTFACE FACE NIL DEV)) - (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE)) + (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) (FLET ((GBCS-TO-FONTDESC (GBCS FAMILY) (LET (FONTDESC CHARSETS) (WHEN GBCS @@ -487,7 +540,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (FIRST (GLYPH-DWIDTH GLYPH))))) (MAKE-GL-LIMITS :WIDTH GWIDTH :ASCENT ASCENT :DESCENT DESCENT))) -(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) +(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Feb-2025 12:53 by mth") (IL:* IL:\; "Edited 3-Feb-2025 23:00 by mth") (IL:* IL:\; "Edited 2-Feb-2025 20:29 by mth") (IL:* IL:\; "Edited 28-Jan-2025 23:09 by mth") @@ -496,11 +550,12 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (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 (IF MAP-UNKNOWN-TO-PRIVATE - #'UTOXCODE - #'UTOXCODE?)) + (UTOXFN (COND + (RAW-UNICODE-MAPPING #'IDENTITY) + (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE) + (T #'UTOXCODE?))) NOMAPPINGCSETS ENC XCODE CS XCS) - (UNLESS MAP-UNKNOWN-TO-PRIVATE + (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) @@ -512,37 +567,57 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ XCS NIL) (SETQ ENC (GLYPH-ENCODING GL)) (SETQ XCODE (FUNCALL UTOXFN ENC)) - (COND - ((NULL XCODE) - - (IL:* IL:|;;| "These assoc with the Unicode encoding") - + (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:|;;| - "Unicode encoding is > xFFFF, put it in the NOMAPPINGCHARSET") + "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 NOMAPPINGCSETS)))) - ((AND (INTEGERP XCODE) - (<= 0 XCODE 65535)) + (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) + (COND + ((NULL XCODE) + + (IL:* IL:|;;| "These assoc with the Unicode encoding") + + (COND + ((OR (> ENC 65535) + (= 255 (LOGAND ENC 255))) - (IL:* IL:|;;| "These assoc with the 8 bit character code within the charset") + (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 XCODE) + (<= 0 XCODE 65535)) + + (IL:* IL:|;;| + "These assoc with the 8 bit character code within the charset") - (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS)) - ((LISTP XCODE) + (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS)) + ((LISTP XCODE) - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset (like above)") + (IL:* IL:|;;| + "These assoc with the 8 bit character code within the charset (like above)") - (LOOP :FOR XC :IN XCODE :UNLESS (MEMBER (SETQ CS (LRSH XC 8)) - XCS) - :DO - (PUSH CS XCS) - (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS))) - (T (ERROR "Invalid XCODE: ~A~%"))))) + (LOOP :FOR XC :IN XCODE :UNLESS (MEMBER (SETQ CS (LRSH XC 8)) + XCS) + :DO + (PUSH CS XCS) + (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS))) + (T (ERROR "Invalid XCODE: ~A~%")))))) (IL:* IL:|;;| "Extract the lists from the TCONC pointers") @@ -583,64 +658,22 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SUBSEQ NAME I J) :WHILE J)) -(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &OPTIONAL MAP-UNKNOWN-TO-PRIVATE FAMILY SIZE - FACE ROTATION DEVICE) +(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &OPTIONAL MAP-UNKNOWN-TO-PRIVATE + RAW-UNICODE-MAPPING FAMILY SIZE FACE ROTATION DEVICE) + (IL:* IL:\; "Edited 5-Feb-2025 15:05 by mth") (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") (UNLESS (TYPEP BDFONT 'BDF-FONT) (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) - (DESTRUCTURING-BIND (FOUNDRY FN-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") - (UNLESS FAMILY - (SETQ FAMILY (REMOVE #\Space FN-FAMILY :TEST #'CHAR=))) - (UNLESS FACE - (SETQ WEIGHT (OR (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 (CDR (ASSOC (STRING-UPCASE SLANT) - '(("R" . REGULAR) - ("I" . ITALIC) - ("O" . ITALIC)))) - 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") - (IL:* IL:\; "Ignore others") - (SETQ EXPANSION (OR (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) - '((#\R . REGULAR) - (#\N . REGULAR) - (#\B . BOLD) - (#\S . CONDENSED) - (#\C . CONDENSED)))) - '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 FACE (LIST WEIGHT SLANT EXPANSION))) - (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))) - (UNLESS SIZE - (SETQ SIZE (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) - POINT-SIZE - (FIRST (BF-SIZE BDFONT))))) + (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 (\\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) + MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS (PACKFILENAME.STRING :BODY DEST-DIR :NAME (\\FONTFILENAME FAMILY SIZE FACE @@ -678,10 +711,11 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (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 (2252 3873 (FIXUP-CHARSETINFO 2252 . 3873)) (3875 5300 (PACKFILENAME.STRING 3875 . -5300)) (5302 10486 (READ-BDF 5302 . 10486)) (10488 10811 (READ-DELIMITED-LIST-FROM-STRING 10488 . -10811)) (10813 16395 (READ-GLYPH 10813 . 16395)) (16397 22114 (BDF-TO-CHARSETINFO 16397 . 22114)) ( -22116 28166 (BDF-TO-FONTDESCRIPTOR 22116 . 28166)) (28168 28765 (GET-GLYPH-LIMITS 28168 . 28765)) ( -28767 33408 (GLYPHS-BY-CHARSET 28767 . 33408)) (33410 33773 (SPLIT-FONT-NAME 33410 . 33773)) (33775 -38484 (WRITE-BDF-TO-DISPLAYFONT-FILES 33775 . 38484))))) + (IL:FILEMAP (NIL (2433 4054 (FIXUP-CHARSETINFO 2433 . 4054)) (4056 7088 ( +GET-FAMILY-FACE-SIZE-FROM-NAME 4056 . 7088)) (7090 8515 (PACKFILENAME.STRING 7090 . 8515)) (8517 13701 + (READ-BDF 8517 . 13701)) (13703 14026 (READ-DELIMITED-LIST-FROM-STRING 13703 . 14026)) (14028 19610 ( +READ-GLYPH 14028 . 19610)) (19612 25329 (BDF-TO-CHARSETINFO 19612 . 25329)) (25331 31421 ( +BDF-TO-FONTDESCRIPTOR 25331 . 31421)) (31423 32020 (GET-GLYPH-LIMITS 31423 . 32020)) (32022 38036 ( +GLYPHS-BY-CHARSET 32022 . 38036)) (38038 38401 (SPLIT-FONT-NAME 38038 . 38401)) (38403 40582 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 38403 . 40582))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index c74d9abef88774648c5c1b515047cc73bdb78e0d..6516856128df8c730b1005d22ff8f3b88b6cd28a 100644 GIT binary patch delta 5900 zcmai24RBP)k$&@b^|$(4A!+rCv|uD5i#13>!a^3X+I=fM?P}k$Kl&E}j1I{mB4=zT zV8br>r+jDGSd4A<1tn*MF4V=u1;|d~z@dQgA1UJ`{Ftkw&b~W4_5~-oGhE$OTo}3J z8S>fxYIw__{oeZrH#{)7$=*4*X=HHQrVZPd*z4>t;r<6V+`rw9vzFYNcI;%GnI-Yh z%@uc)v?yVR$Jws>x`DV9M@a2a9G;-o?(jR?6}>gSkAF~_JLO2&$+B;=0{)MQ4Xln| z$*$lfNuNifacbCf{Mq|r040XPLDk<9qiHdIEG4&&BX0Jo zp|C)A$M=mUHG62^uv?x;vd@XZ!-DMLU!)WlJTJi(U~-b`4=XK7P?E*y<9wN=DD#Cm zGoIi*mLmRwC5t~{vGSi-()l4v4*w_UzYV{8ZOKvTZ^5ty47)p3ceu5B*7kweZlUWb zL!zTYafP+uti<>nTcaSB0*YFE-GSDS-Wn65dt-23@n=Vqoi3LW3TZ*$QvyN7t-73H zg|APwWFL&bASJJP9gbA8O0@5T{Crjce<8JsJ;cwXek)}RB;d%|7M_;BYHE90Era9z zQTk8&uAn2{qB-v)`y*m6Bg=`sw4KPs0U{R^BEMciUaZ;nF4>)Cj<~ zM57M@17Vaf8#EX)Wb9cUuxeG`kHzAn2`xUg-4W+vIoIG+Q(Jrvz#w`Z0lk&vC-^z* z!pzUaX&n(K{Sp7dTC(_K^cJZgN6dQbcXNb)!<||AD}Fx*`$X6R>&}o%@rP&U{$Y;X zr~KKhg0kNVtEXeJm~mp)zvjp5;K$bG{|4TWbQ5eTW-6xTzmrAeoQU#YnDX?tG&;+f z!@tJc=6yTwT9PF1xe5Ph^30`pmtUEum8UI56)bfD5lbeK6go7PJfr3YZ_n;xH~0^- zOH)2HFCv*tem?u5=p0{q$(LTHd(oF^=u5BRORwQeui;Ct;Y+WPLcB%_@fs<_Yorjb zkwUyi3h_b;A-y(=fmI-W`=8m6(7ou&cBfYncM9E+hFg&Kah981u%GxiwK}!mrS<@K z8fx;vK-3lbM;nD)#Gd5xpTv#{);hKHI$&*A_9-q$5x0D-+f#vgm z%`N5&Y&nG?N*=TE5}y$%mqo-X#%+}y2sJj-sGXH_#o3qdH&5K_bKPS~|bOKj0sqn9oH zYV@+DaMa8QJr*BL)SBD)hgnJdVBXT@xiI#ZVj5xsW6B6dRyJkMKg?Rn3g!lNIyvoK zYR_Y$RQxW@4dsH63)Ehu_7b(1sePY+Uaye%NIx^#kS*gc7d{Q`Jw-*gZc-0lU-S&y&i_ypD%_Yv zM(&j}b&bLQT%$^|O}wwTdv@5W2N?Xf-5Q>Huh_}vKd9+<&DSe)^vYDdQr0W+%)&;} ze}=#8ZsT9L3)#>3eB~8>RcT0R^Z7OFP+?&q&-XZ@$Ux-?XU_Fkv)iNj!)dT%wiya$ zdcYYBDGsA-BC0}oBtxoGeR$ld2sP0*b|71YmD{KITf(i_olhf=04tq^5tHJh!#y0| z8y!s-1>O+}xSS#7K9bzI9_I&@cCAC{1vWF(-QKME9G-~Z6;?HWvA!+?-~=TY)Pfmk z;SpU$vH^l1tu5mBI-EYA)~UD=Bp$x33Ay|M888Qx>?>bD-cFjhS$JLWm*Z&mY&z?@;wPN6GM^akh1n+F_Y() zSJ=)j#*Q?$kg&4_M0WE?`A+o!46v7kt6wCk?;^5SAdeA3;@bo=L`WQEItAh*WIr#e zsLAGN=D!G+P7(h6)cT5_vHlY>OdvfczjjQ^Ym#x=_i31R^8~SzkC2AR9@tcp2*vYA)JF{5xRR*dEMnf@1C5rtEGZXfKB&qRH6GV?p%GoCj0@czN z2nSms#H;Ja^-exg^&Qs9KdEY}d)s?ce93~U%;)|ClQ3|RcNnrkvYlx*t5~qjHQdwMvv%s?dC4q;L{b-hbU0(=@ z^zVd_bAE-aG>OfbS@ehqz`rNtjXhFerp{1`dYa%jan6&(zO|FcS+Rw(4(gq83nG?! z#x8mpf^e<6RNTfrd{=dOx|{^s*ef(x#gA1t_EIPZbT8tqh)Wd8jRL79gv84QQbGuY za+W|+2-%NQuM;BuR!rb6HH&KAZ_-s!oGw@Cs;Ezw3Url9lyoskS4EY&UzP_vdqZYDd})0t`%kXbH}p@SP!XLj%hvnQ=Kqi}9FSgtuuSd4jO%KK zU)+=UgphOAlhkgf-hY?ia#7P&y%Nb`f*#}_*ZWW91sU;(o zuWwkJ-fNPiWaBxJ!cR3c(7Fl+;-lF?XQw0LSE24J4tS*mpd8siIr|hAmDC6C0l%vT z`xF%N9mu|`&qwk$nZJSTDZDyHk-?8<#185Gyk}*3BL)xqCduwXc97Uh$TlJ?mmzB- zlw$50sh2*|d-G{=fIL1`NpI&uWM)QHq zuo5W+o1+E%#Hu?|#)cki9vg}cALk#eigYlWmca(B(?h2;E7TmQu5#};)QpqO$M5!z z+`M`HxP2?4UJJI8Tvy$2d8I-4{M?@vj0P2*^R77dxXBKFGpmIG-2Gaeq!lH{x=Ouzrp2p zI)i=~mVPoj{377u>&O`lI=f*sDm{g=a9ctmB4Q%F#p-ERjIyxoDa4-Kl7;QhVS>r! z#P^bX0$vs-c(WjX3~+W2audKMC~G55ANIaSnjS}%K4E2i8p>2vWHpMsxDai?GJ0#s zlpTM6Yo2sYzjf2~_j%JID2P{4-atXPp_; z%wAVB<{xu2ZTgM7aW4Ta1pCzdqSD0Z@Yqh1gG3%%OyqGs=FW)@7&+7}{vz}e-J&(( zYOSFw+r?gMm3!EUHkqAtkGW&&#^h<&@lv|eB<&`#RJ@$T!MJD46Z39Nn^wk@m~W$H zdW~E0v}Ckcn_cPf*8)SXpPg!t$^&%uwG4S+9vjG+*5=6rHa3tyt=VKYP&lnw2a2bM z21=&2Vp2YKv_UIo(D!R4v;-%$pr6*Fm83%|lO(vgl0-{_i881-dRoheSwp~TC59$N zE9qwliT(xv54ht6O|ZSmLDmdK#*=&SH$1oQK?!bL0rzKRB{usg#w7Vc~*5M{@9 z`((l2YN(1@F(@ka6-XA5YYrn@suv=$>JA{%XEZ=J^#X}X=WmHh?~tf8A!J5~yg97* zdi42D>fE>oi8Pt3hcgJ+O|OeoK&h zlkhErPXU$}A5C?u@KxaK#uSNTr{_ZTkUg>L-tGfu>WVtf*rWVGZ-sRP?8<(P9yan* HH*fwwhNRUZ delta 5385 zcma)Ad32Q3760BhStc`C%|<36nS_vyOaj@^Adp$UB$JuU7iK1jfrQAWa9pcEK_MBa zQmZKt9?Lvg1fsPH^?*T($}v{7)w;8JPLHQ`rAM?qMLb8_KT7Yt?+X#?Ic+le?tQ;^ z?|t{Z_j~t!lU=*n;azNNAFCN&nAKY6XkND1Q8T@!-d@dsv zk+?gCW)7D&up0hMN-6imf0Hl}sTkigz_T0?u|#v_^Rx zxo<<87{50Zj!-+onI+T1W#d;;Yyi(>@O0^&0T0A-={HRT*sj2gAV$155Y}3>prT5r z2l#wTZr_fp0zC+Uk|0n=Q18%!VXqdNh_f@YLE3HtqXaMtb$dPG)(L}M;|4!B3_Sd( zC9lA8#dOAmtr)lc1y8b0;wEbvZ?LA7?7k|SM~pZv{+^Cj$Rr|rH}gBJrRn>lI~8-& zNmyVdRiTyH&!4n<*ed?D^=`Ixv@dZjgJu3O>G;hb;x_z&Y|f$j8&c1r%1J%5mc;3P z5~nm0AIv22{!|k0rIUD%_Wh(Kbb_zfQC<(Pqkv@>t|sn<5$1rWz9XM|hkefkVKo*l`Yt zf%qt&L>X-1_oeF7_C_Mnq1YC`x7`utGRF(Bde#=d12Atm9_}f)x=fP|VBnGKELvAe) zo{0DNs|^1NhKXe7(F{X_0bk0zUWr5^#y))WUu^h>f1lP`_X(u02otPH#FR&qc_WR) zoAPx1(UdLP5@|EWxAX#EdEHO5FT^YA#>?iN*Y1LW$ zc$iC&kq*pgHyiZ4#NSUZNcc-kF_|ax@6%TgUd0O^@xsT14|$P@`|mS&;WK#QGkD=M zc;N$HkeyMXd`5-x85PQBR4AWOp?pxG$UcksGzH9m{Pzd+O3k!6hG8qrS^&ra)x{vv zPMn9bi=I(>3VJ@uyEA8(5h3GLI z)hHS)n_IK;EaL@z92iLwPGAD1aF`!rtI>D+nq2y zNmVxGTB@?DYpKer__Nuqbs7H$RbhXT9|p%*@o3egCs}oI&edE^qJ4Oqp6^7r{$S^D z$4>Eo=S<>xwt0hH*!&XBSSPCQks3zzIZ{KY?j|*e>IPJmbGMQ>+fL$)ER&~YnLI^h zlFgGPXuM3aYM3*+Mw*Vxl0AIHwt|0cTRXLy!RW>rV^qRm5t)rbkDrwu{&4PQwua~A zg=~xBv5PHMQ-sdolWAPDYzg0#*E7+bDmoZ^vaWQG{xi?X(pKuCYO*NL5am`;u8MMn zzfkxuwwfO+>SFhE>y#4rNE;0>&_pSW)WXea_GvxcdeGA$kM6o`vRD_h9{OVEb?RYl z1tF0}Dfr4MPnU$Lz_8U!gjp_R0k&}^-L1M`gISV<($&d5#fMnu=s$|zGQk8-logn2 zYis$R%W~VgVVdeC96<{PbzFY+DGI+E)j{Y`r&go71|$2mKufq4o3~FGg-Kn{Z!FjI z(M#DOXv-f$k5H#8q|LjZO!o4p%1g8MmtjNMT143X91^?v`SSJNN1=lq5?&Ph$%;C+ zNaO)RqS$$_M3xh>3z2S#_zBs`4_DNrZv$MpNVxJc;oC0{^)*Q8U*PGF8A9d4gHjz58jv|cAhe^fDSE-I>>UpAEicAuZbF*WF?HoPqNMo+! zz&eFs94NvPNq>>WkbFr|ywM?(%hRkfP+jTRLFE7O`PMg> zaw(ffWpW3(d-}{-|1-J{PMnD4!8R+w=jd z$_PGQHP9uXAC_Evf}jJ~yN6U9S@|WY2T^^9)RFZh_RConcTsDfM+%wpKD%rsOTpi% zD@cXnm)Hhd=5YG`dbj4`-_(^PvGWj@9V4>}KDB<<0-|?^@FCucxa7txiPRE8^e&M| zJ|RT!G>Ie-vJ+h|5u#i`giYly)fbnan=QPuOrD)4ys}cB$q`=pPI)?BcxAmj#mx;* zu%6Lp8opHvdvX-TWK_nO=uk|v9teYQhctPv-{yDD&fy>3VDDQ8BdNKx@GM;{z$Ct- z(Xm502Hdsw;sUr`@Q0I>uf6Qj&1ALPDSE4o3u3eL zkW+jwyiWw&HQ4?H$5I)pZ;8n$eov#nkLn3LUZI|Lm+q$*0>lo8UVeUdN%H_U?m!~T zqwnbKa63a9qRS}4QB-G9coV8wgc32oqLGx(#eCi}XL{271nhqv`;`&?z?=o_cl_fy zbCO=8uW@QJ_MRG@HurAEcJe());*tgs< zc4UyZyNlU;evi90uEcle<;$1&ad(M&xoY%d_abKNO@z%c5;Yl2q&#Rxow%dwaRP8L z)Y~BSn2;XC7YX$iXrvgM*W4L!hrN0L@ouzNu~w+<{ADd?kj|Y1=rA#i#ZHh}A*#Q< z;=z7Bq0)VzPC)~D{iF!2OVlAkg_z-HGb_34?u9aAf_DVOv8b{eQFDV9tIg|l`mr?!Y+}M% z2p5GtOJPe;rSGC@>Bef%M+h!Mcsr?h4%rq`D?n9_$iKh-h|DEvjsG&=zm)K_=K0!{=P z*X`%^rQs@Q{;8ygBc zgJCsqv%|940jFZ2EF$WIygR?mJF1Oiii!J=F zf<}{Pw1z)h;22zN9&2)YwC0v%R}y@~Qj`RI^xIf}-k5Gv`}0}9eN4|+`-@nA@t9tu z_Ls2!vN63xW&IUny1l=0YR`^h#34w7&hi$!=-zA zpuzqr1`)$|U3Q5ayr@1RUo-DUgnf<=|Ad++Y7t2nr6^*krJRPS2}oI|JFMY3R!+)} zr$r6@KS*usq4Mav!mA2z{Kg6xzB@W(^?2dk)Y*ggGI*=-vU&}qe8;C0R Date: Wed, 5 Mar 2025 13:12:13 -0800 Subject: [PATCH 6/6] Fix a bug where I assumed glyph names couldn't be parsed as a number; and a little cleanup. The linux otf2bdf utility uses the hex of encoding value as the name, which can appear to be a FLOAT and overflow (i.e., 3D39). Similar parsing problem fixed and corrected an error message. --- lispusers/READ-BDF | 176 ++++++++++++++++++++------------------- lispusers/READ-BDF.DFASL | Bin 19863 -> 19858 bytes 2 files changed, 92 insertions(+), 84 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index d94a9a478..afc91dd6e 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,15 +5,13 @@ 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 " 5-Feb-2025 16:11:53" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;35| 42056 +(IL:FILECREATED " 5-Mar-2025 12:44:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;39| 42641 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR WRITE-BDF-TO-DISPLAYFONT-FILES - GET-FAMILY-FACE-SIZE-FROM-NAME GLYPHS-BY-CHARSET) - (IL:VARS IL:READ-BDFCOMS) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO READ-GLYPH) - :PREVIOUS-DATE " 4-Feb-2025 22:28:30" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;32| + :PREVIOUS-DATE "26-Feb-2025 15:23:23" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;37| ) @@ -159,7 +157,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST X)) Y)))) -(DEFUN READ-BDF (PATH) (IL:* IL:\; "Edited 23-Sep-2024 12:37 by mth") +(DEFUN READ-BDF (PATH) (IL:* IL:\; "Edited 26-Feb-2025 15:22 by mth") + (IL:* IL:\; "Edited 23-Sep-2024 12:37 by mth") (IL:* IL:\; "Edited 22-Aug-2024 16:43 by mth") (IL:* IL:\; "Edited 17-Jul-2024 14:45 by mth") (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") @@ -183,71 +182,78 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (UNLESS (MEMBER KEY '(COMMENT CONTENTVERSION)) (WHEN (<= POS (LENGTH LINE)) (SETQ LINE (SUBSEQ LINE POS))) - (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) - (CASE KEY - (FONT (SETF (BF-NAME FONT) - LINE)) - (METRICSSET (IF (AND (INTEGERP (SETQ V (FIRST ITEMS))) - (<= 0 V 2)) - (SETF (BF-METRICSSET FONT) - V) - (ERROR + (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))) - (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 + 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 + 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 + 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 (READ-GLYPH FILE-STREAM FONT)))) - (ENDFONT (SETQ FONT-COMPLETE T)))))) + 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 (READ-GLYPH FILE-STREAM FONT)))) + (ENDFONT (SETQ FONT-COMPLETE T)))))))) FONT))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) @@ -255,7 +261,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (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 2-Feb-2025 20:29 by mth") +(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 5-Mar-2025 12:20 by mth") + (IL:* IL:\; "Edited 26-Feb-2025 15:23 by mth") + (IL:* IL:\; "Edited 2-Feb-2025 20:29 by mth") (IL:* IL:\; "Edited 23-Sep-2024 12:38 by mth") (IL:* IL:\; "Edited 22-Aug-2024 20:53 by mth") (IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth") @@ -275,14 +283,20 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (READ-FROM-STRING LINE)) (WHEN (<= POS (LENGTH LINE)) (SETQ LINE (SUBSEQ LINE POS))) - (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) (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 been started.")) + (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)) @@ -341,6 +355,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST GLYPH)) (DEFUN BDF-TO-CHARSETINFO (FONT CSET &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 5-Mar-2025 12:39 by mth") (IL:* IL:\; "Edited 3-Feb-2025 16:02 by mth") (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") (LET (GBCS CSGLYPHS CSLIMITS) @@ -360,12 +375,6 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST  "Assuming that FONT is already the A-LIST form of result from GLYPHS-BY-CHARSET") FONT) - (NIL - (IL:* IL:|;;| "comment in COND still must be well formed ...") - - (IL:* IL:|;;| "((TYPEP FONT 'ARRAY) ;; Assuming that FONT is already the array form of result from GLYPHS-BY-CHARSET (LOOP :FOR I :FROM 0 :TO (1- (ARRAY-DIMENSION FONT 0)) :NCONC (LET ((CS (AREF FONT I))) (WHEN CS (LIST (LIST I CS))))))") - - ) (T (ERROR "Invalid FONT: ~S" FONT)))) (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS))) (LET ((TOTAL-WIDTH 0) @@ -709,13 +718,12 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST :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 (2433 4054 (FIXUP-CHARSETINFO 2433 . 4054)) (4056 7088 ( -GET-FAMILY-FACE-SIZE-FROM-NAME 4056 . 7088)) (7090 8515 (PACKFILENAME.STRING 7090 . 8515)) (8517 13701 - (READ-BDF 8517 . 13701)) (13703 14026 (READ-DELIMITED-LIST-FROM-STRING 13703 . 14026)) (14028 19610 ( -READ-GLYPH 14028 . 19610)) (19612 25329 (BDF-TO-CHARSETINFO 19612 . 25329)) (25331 31421 ( -BDF-TO-FONTDESCRIPTOR 25331 . 31421)) (31423 32020 (GET-GLYPH-LIMITS 31423 . 32020)) (32022 38036 ( -GLYPHS-BY-CHARSET 32022 . 38036)) (38038 38401 (SPLIT-FONT-NAME 38038 . 38401)) (38403 40582 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 38403 . 40582))))) + (IL:FILEMAP (NIL (2291 3912 (FIXUP-CHARSETINFO 2291 . 3912)) (3914 6946 ( +GET-FAMILY-FACE-SIZE-FROM-NAME 3914 . 6946)) (6948 8373 (PACKFILENAME.STRING 6948 . 8373)) (8375 14009 + (READ-BDF 8375 . 14009)) (14011 14334 (READ-DELIMITED-LIST-FROM-STRING 14011 . 14334)) (14336 20558 ( +READ-GLYPH 14336 . 20558)) (20560 25963 (BDF-TO-CHARSETINFO 20560 . 25963)) (25965 32055 ( +BDF-TO-FONTDESCRIPTOR 25965 . 32055)) (32057 32654 (GET-GLYPH-LIMITS 32057 . 32654)) (32656 38670 ( +GLYPHS-BY-CHARSET 32656 . 38670)) (38672 39035 (SPLIT-FONT-NAME 38672 . 39035)) (39037 41216 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 39037 . 41216))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 6516856128df8c730b1005d22ff8f3b88b6cd28a..87b9e2076c1839e153a03b33a72db37016e29bfa 100644 GIT binary patch delta 1128 zcmY+DT}V@57{||tpP_cNwM=9jOy`^*Y;Ml_K2~UbT0?+wGz$Lpp`dpU;iT|r-<;rlOgRQ~~ z`wL@r$@2!hRd6_C+Px;EGUVgl)@7-&bmLo&x7lp?qv#%RUPcmaN%{ARvQ(BTnWbgJf2bnam3>I*=aauajIJH6xLRH;jt% z{qLm`;zM}>VS^~*Gy6A)bMX~2lAIYfHx&|OQlmRnZh99;r_-x9{@r1?Zz;MRbPG(R z^AKLP6@;EBH)X!5&P9F~Zh`0o*C|gu94(IvvQKF!PD$)g(GdwC4+oHEyW-gX%qIY7G||@T?-*H zl6Sd6opc^MqS1c3f1feHqY+&W**V9&p2LD$@+1I!y*(bn41!(Qo;FEk)1fxalp|VxHRk&echwt z;80LJ>-7$bqrvWxptq+?-0dh1^o@@84fd9S^`#=4!5YJk34L|i-k(Zf6j`u}!J*;O qfcK&|Af6u@86XBG!Yh~^XOqZHr?hr>TH8=-JHz7fW*tAdv-1~XSVf=! delta 1111 zcmZXTUr1AN6vywq)9LIFbFH;xjEl`REn}N*qP?`W)n>NeSc@#M%fjW>E>>!RTCDV; zqG8P+)xG&r78FsWt(S_pP!j#8Aomi5P!UuQK`#-+`kmi}40^cte9z~c?>WEy#vPwv z&rPtWyI4Gtq0Z=1{2=4r|w$U|lI-_rCwqxOFTp3}Cn z9$Z?ovf!(jwBl0TQv9{9njI}v*@GZ7oziH$9w&A=k8#{DeAhX&FuP7inwTAv)7*Z%&Sk4;r};g+-&McZ61lb)suU^s zrfV)@&;oeE2u1~|`Y|V%6tq~Ztb&SQRzwb&i$V=By~->~O0bfLCr_=iN3bbKFW41i z$M4+Bvo-3<=lRr;wBW$VF=c7*fmx!ShV-IxI@t;h6ZAmsbgr@onKPfhUqM!}@-tb0 zY{*n33q(D#WM+$G9kK`x1vxUmf8?jU$cSoRks43U$V$Tt1}UgE^G0YOM#PKyS)z#1 zk(njdsYl30Y7RKDoe;Y+U1|-{D?kRLNjcF$Pxw8bzBB#%Xh_e`9LM&%GlHByoX`^z6NcJa{!yrG-%ZG9;AIe8O=P1G;~G9aDKmB)O6 za3{&wqI4#w^@rn|eNjlCLLXNF@;0@s0(prJVb7}JxEhAl&_`Bk{Qhhw-NzIDzQ=`K~J?xbd;QfVLvEgzNiKu&s0(%C(td}68FX8>hH#1 zJuU1`yu$1BTP4hm@nbq@e=p@4!o3F*V!E662R87#(_)fu