From 1491fa91cc9880892a52c6f602061399a6ae6069 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 14 Apr 2025 12:08:10 -0700 Subject: [PATCH] READ-BDF add ability to create FONTDESCRIPTOR and write DISPLAYFONT files (#2015) * Now can create the FONTDESCRIPTOR with all non-empty charsets. Can write DISPLAYFONTFILE format ("STRIKE") files for the charsets. Add ability to use mapping of Unicode charcode to unknown XCCS charcode in the private space. * Create 2nd FONTDESCRIPTOR for unmapped Unicode to XCCS charcodes, organized by charset-like (8-bit splitting of charcode) of Unicode encoding value. * 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. * 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. * Initial documentation file written. --- lispusers/READ-BDF | 668 ++++++++++++++++++++++++++++++++++----- lispusers/READ-BDF.DFASL | Bin 9773 -> 19858 bytes lispusers/READ-BDF.TEDIT | Bin 0 -> 6302 bytes 3 files changed, 589 insertions(+), 79 deletions(-) create mode 100644 lispusers/READ-BDF.TEDIT diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index fa4689c9..afc91dd6 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,20 +1,34 @@ -(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 \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 "23-Sep-2024 12:38:25" IL:{LU}READ-BDF.\;2 12260 +(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 READ-BDF READ-GLYPH) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO READ-GLYPH) - :PREVIOUS-DATE "22-Aug-2024 20:54:00" IL:{LU}READ-BDF.\;1) + :PREVIOUS-DATE "26-Feb-2025 15:23:23" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;37| +) (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 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) + IL:FONT)) + (FILE-ENVIRONMENTS "READ-BDF") + (IL:PROP (IL:DATABASE) + IL:READ-BDF))) (DEFSTRUCT (BDF-FONT (:CONC-NAME "BF-")) (NAME NIL :TYPE STRING) @@ -24,11 +38,127 @@ (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) -(DEFUN READ-BDF (PATH) (IL:* IL:\; "Edited 23-Sep-2024 12:37 by mth") +(DEFCONSTANT MAXCHARSET 255) + +(DEFCONSTANT MAXTHINCHAR 255) + +(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)))) + +(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 + #'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 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") @@ -52,71 +182,78 @@ (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 #\])) @@ -124,7 +261,10 @@ (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 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") (LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT)) @@ -143,14 +283,20 @@ (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 ben 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)) @@ -174,7 +320,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 +343,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 +354,376 @@ (ENDCHAR (SETQ CHAR-COMPLETE T))))))) 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) + (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) + (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) + GLYPHS-LIMITS BMAP 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))) + (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT) + (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT) + (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO)) + + (IL:* IL:|;;| + "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)") + + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I + TOTAL-WIDTH)) + (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) + + (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 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. ") + + (IL:* IL:|;;| " From \\READSTRIKEFONTFILE, so -ve DESCENT is possible?") + + (SETQ HEIGHT (+ ASCENT DESCENT)) + (SETQ BMAP (BITMAPCREATE TOTAL-WIDTH HEIGHT 1)) + (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 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") + (PROG (FONTDESC DEV GBCSL 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 (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) + (PLUSP SIZE)) + (ERROR "Invalid SIZE: ~S~%" SIZE)) + (COND + ((NULL ROTATION) + (SETQ ROTATION 0)) + ((NOT (AND (INTEGERP ROTATION) + (>= ROTATION 0))) + (IL:\\ILLEGAL.ARG ROTATION))) + (SETQ DEV DEVICE) + (SETQ DEV (COND + ((NULL DEVICE) + 'DISPLAY) + ((AND (SYMBOLP DEVICE) + (NOT (EQ DEVICE T))) (IL:* IL:\; + "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.") + DEVICE) + ((STRINGP DEVICE) + (INTERN (STRING-UPCASE DEVICE) + "IL")) + (T (IL:\\ILLEGAL.ARG DEVICE)))) + (SETQ FACE (\\FONTFACE FACE NIL DEV)) + (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) + (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)))) + (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 (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") + (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 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") + (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 (COND + (RAW-UNICODE-MAPPING #'IDENTITY) + (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE) + (T #'UTOXCODE?))) + NOMAPPINGCSETS ENC XCODE CS XCS) + (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT + (CONS NIL))))) + (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY) + (TCONC (AREF CSARRAY (LRSH CODE 8)) + (CONS (LOGAND CODE 255) + GLYPH)))) + (LOOP :FOR GL :IN (BF-GLYPHS FONT) + :DO + (SETQ XCS NIL) + (SETQ ENC (GLYPH-ENCODING GL)) + (SETQ XCODE (FUNCALL UTOXFN ENC)) + (IF RAW-UNICODE-MAPPING + (COND + ((> ENC 65535) + (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC) + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + ((AND NIL (= 255 (LOGAND ENC 255))) + + (IL:* IL:|;;| + "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode") + + (WARN + "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR" + (LRSH ENC 8) + (LRSH ENC 8)) + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) + (COND + ((NULL XCODE) + + (IL:* IL:|;;| "These assoc with the Unicode encoding") + + (COND + ((OR (> ENC 65535) + (= 255 (LOGAND ENC 255))) + + (IL:* IL:|;;| + "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET") + + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) + ((AND (INTEGERP 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") + + (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I) + (SORT (REMOVE-DUPLICATES + (CAR (AREF CSETS I)) + :TEST + #'EQUAL) + #'< :KEY #'CAR))) + (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC + (LET ((CS (AREF CSETS I))) + (WHEN CS + (LIST (LIST I CS)))))) + + (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.") + + (WHEN NOMAPPINGCSETS + (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO + (SETF (AREF NOMAPPINGCSETS I) + (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I)) + :TEST + #'EQUAL) + #'< :KEY #'CAR))) + (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC + (LET ((CS (AREF NOMAPPINGCSETS I))) + (WHEN CS + (LIST (LIST I CS))))))) + (LIST CSETS NOMAPPINGCSETS))) + +(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 + 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 (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 RAW-UNICODE-MAPPING) + (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS + (PACKFILENAME.STRING :BODY DEST-DIR :NAME + (\\FONTFILENAME FAMILY SIZE FACE + "DISPLAYFONT" CS)))) + (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) + 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 \\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" :COMPILER :COMPILE-FILE) -(IL:PUTPROPS IL:READ-BDF IL:COPYRIGHT (IL:NONE)) + +(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (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 (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 3408119194e806ad4feb59000778d70941566178..87b9e2076c1839e153a03b33a72db37016e29bfa 100644 GIT binary patch literal 19858 zcmcJ13w)f_b?5he8olLVERSVb$ns!>u!YC?fgzB@(P(Dm`R4VBnUO8|fsnDn=wX@l zBdxA#Ibc#8M*g!>76_J*X`)rvuB+-vZsI7@WAf7*6rxuKHR@=9l?8d_wU-h zE)nzvyzPOG6`x&mb5*jajyrbs_wDK5?(wYk#`<=7SFc>X*0XB$EjQe7%c_-C9lm5# zHf6JI?B71pzk7S%zU7{^9u&AE?V%#e3uP|8kbTCudZ&gzcjiB;37R`sXLKcHT$-V0 zk7S%3W;EzW?^3}))bblz_Q{N^HJS3o1HMGSYsNdfQmxsHYn5lu&bz$B{a@-IrfJw= zpo;8MnTn3CxIblD@$6xJ)L4WHU4dYS84r4?UKH=JT&U4ubq3=`H42njT`5#q2Cy<< zCW2hpsLviIOnIlzAMvdZW)GKU4`r%QlZ_b5X6AMW6IQp^Z^dF(+#5BMo!LwYW;A=a z1Vu}_l0oFLYT1l~iHt4_c6VBdR5nv#FF-cav@v0(g0vXkl;sVeqNuN@!-}W4&&llJ zCDczd#s!aL=4|n8Snm({5*y7xDufYMZRuDaOxd~0EmX9_=MRE3M`keexGzSC>Mb3~ zV9M&CPgxXzT@*wVP4>jvttb;wZ8C+9#*mx0#f)PaqETuZg=i{)uGoUvYxiNWM>1vY zW~x0(_0|B2`8wq~7V@E>xjsbnYDu>nu4<2BqLU$CfU2oL9X9MhR|3FQ`mJ~%7*7T% zQ$4c__1!Xmhow-JCc6C*PHgo>)JIiiUq&1zXJ z7%;nNDJ?a0VY z@l?h^vsR^NGi7(j_YM!=tKpnzR~3#39}PYyIR+QVQ-Y1Rde+|GO%zc=TV8ijhp{A` z7-`9s$kf;y4I4FC21F%wDS-2pr1O^FheloYaC!Ey1Gp-5zssNMN(7VG_7$`-X((B2 zdfwoNGL`G2*zqwll@uYcl&+8VbcO(O@yZRpgh@lC(p52Ew^}Y{twuf-GUJ3}gez`g zr*xWe-qYAvR82YeQypchW^RYs-PP$WT6iwpgdOVb@Wsq%4-$XSn>07!s3)wLmo_}} z%%d|)V0)L1>^LuSG>5=*QL#-hv6O32yL3 z+prBfX-{J51E|q&b@q_NqLTtNqz&(isO1X~C-4ql`@@D@1qjh#e1n;=;;|rPg{UqT zWn7Pgww|g6+ssGXTm-8L^R$u8xG#0F9Le1DZ@jzs)CBm{3>2LhMsS`#hU*wHr<6`g zu5iW};xp#bvYA>4c)9gG_MR`Ctde!2eHrH9%4_nc!>cCOOT$d{bOz~!lqGwTsbH)I zw~QOR+1p9dGC-S19;vdML77k7Ufcz^)(WH>ASmV(QG$ufLeJ?*wlrGcUv*@pVO0g;n!*LZZ;TW4v^l z_#&6%9o0s8h03_PL!)S{3`>b&jxuHxWy;Z@nvlbi?=bO^&XAH^`xTd(EXDP-B)%e( z1K@F@rkT^ISdVB}anxB({ahbRXof6wkh+XQGp1UVd1glS4=K(Wi=a549o;W^9|lt; zs>`p8V#wMIk0^%xaw!I3GkgUMRrwld*%ZffHpioiqp+}w<9VCoF~w0>ZN+hP#)vYi zFZMndmDDG(U{BpxGcQ`Vv(rZ*m;&Co@e!s9f#X3L!5JLPyd|^1|v& z;p*KKOeE)mWnO{B?lZ3W8TfqvOBM*ThDC>_#xaI*;2`V6+_@(G)$;U-^yCA5Ck7@9 zn3L&K5A>ZJI90$*rB6T5H#KnD#*_}8+241@&Q+&-ow;%#ZydK0!lMcmVnY+OlbjSDN$NLS(>|@ z=6rE)YtB4kwT9eUE`l`dHgYkfQMV&!wZ?y3R-Ut5&seRN(_N9X+yvFSt8!L7L3Qq$ zoYhEBgWH+2JOnklT{)|npe63woVApo7PlLfsr@omrx^z>;*Z)hbYVDJBEcT)IF^u< z(ve46EFF<8l8uxr97^PrTqH=I5kR&~Bv2h30@Vp2R(T4v8j|V%2PfkS2Pt~2a?pKr zwFnXAzwkzXpTO@k_#T1ZX7F7C4>NdfA17yfIe90@$)DZC$xp7~0=LP}{VD)k5OHVujj%P*zUM zg?t6p3P}|f3P}xC35gR+gv5pQK~jswLE^^Bgw(>kq|Z3WdG%Lszy*4RKNR#wynIP_ z_{^xInFsP0^MpA^m=61_f3iYS#e@0;g=AhqA;~M;G;}2)NFxznt`T>a-7N08LEL-2 z2wyGks}*5ggh@9jrHekS$qPKJRD!Tl3BqLxk1HG(duibsr%Rki^^^!>FF5%U&$mxP znO?)C{QMCi5ur@s0xt6<{m=}-hP#c_Ue0iRU!@BcZv``!zhXZES9QK_x?`F17|>3> zO!G7m;@cEslDFjFNwNDaDYt))0##hI>K3s@M(H1I%n$Np-sy#l<(D&R`P)33Js#EA z-_KzC5Nzl)hLInu;`{G2_@WlSU6LzjVJ()iFK;PuRNgGo- zcxr!N{&FZCoZ8cQgMNVtZdj+;2G@d(apJnAmX#bY?7adq}SDxWD7 zWe4Aah?3il0A4`?c#TMU$yESk?>DWCHl@o^lHWZ_ihZ8Ot=C-7N%d8nR9(SICCehc z!k&U(VG68&uPmA_!w4Z?SQ4o*{%WRtDLke12I`3RH&UkPSIiUPIReL3E%ztOlzN`^ zPmn2B6w4I6+G%MnD^DUUPa?XAkUXg&c@k0bB%IrFXZbVBpMpQ1 z4@oibGAH^1l!puh-^>Sr-lB9{y&fD+$x#@kU74+i>kGjJu|xG-P8G*p zmgl*gHm+X@o;k(!TtXq&8w*UA)yefm1*X|*xqhuZxF#^+Fi^MUvdBr&m)Z=Aiy7G3 z#IvX`vl%>vW(v!wYH78Zt}14-msc@eXEQAUlbS+%*`?&xn`cXI{rcIGTfZJh>e7-s z@~I@ZKELR2UQTl3e9`$-Vhfv4D)i6U68PVy&{w99xP+Ex63`$Ee zWhp4FL|F<-YcXXxC@YAv9F!Hd%D<9S{*_AQU#V37m8|kRL5M?kTeZ(vD=il({dEMn zN$GDOsGgMmCW0DC>0d&Shm`&nf|^O`ZzX6cDg7%5TJEmPSu5o&pkK3a=1n(;h0gqJplu0J}BHFP)Ps1>w( zy@YDiH&S!|mB9@J{+Pio0$*h?Md0%cCJEe6p!VLKoV*+38|_w99mgYU2tK*YR&Y zStfA5*(9+~#M!X$8+2pAtZvvA_~L%>l5Q*KG(&DGG@E5iX0Sb%pI0nU)1E4Gn;gYP96W?hp?OMgq0$xwn?t7jEcTlWdqeGBxYKhR6yCu_RzUg>8UVJ zzyGYS{p=7Mcc;RGgVDi=#LG`!I{ug=*Kg$F#i%3=ogMTKokL+sE~jQyqolCP#(Zzt z9ch27IyZPaHlphn#>VRh&Dh&-Y8PL82&w-qEf*U)dwTrmX`K2b`tMMWeFqFg{v^B5 z^6G0|d(CDllhLmAtlpOI6D|Fsd6T#*EUpfS=9|Ql<)XQYj@;8?86}U(WK=BMO-A5E z5Z*&SyeOdQdo8hIkyz#y%c{jPLoB09BBd^fC*&*p_t`$)Cg;GOP@cbTqenk!8k_a0 zh_O{a6Ek|9I;6hkG-;>wMO7 zaYN@v)6X&h{Ge6GtzJA#7uujzFLQ^|a7=6{csfzZ2Z*ppf((~8pi9a`a@Rz<7%1>+V7jAD)^)X1w=yDxL_&tPR1<0I!fvVXy67ZxpvVfi4Xu5>~=V4csG4O8Riw)P%d@ z5idN&*2Z9fkbE2H2MDYcYbdD{*CNsWH|MlzY}`unp85Q+qZ46L5?&OmcXEFo*g&lj z%ja)J3l2ChQ}cxh+iEGX|B_4+Pa97p#2QNCGHDmrQZ6Z$QsNg&iS=7#3MW65E|~$C z;(Cd(#P!5-7#cN|NQl*x#AFheiK;Xp>yC<*ktaMA@M^_(?(y{H-A1=~?n~Zxjdm1E z)X@LiclC{Ihac!tUPxBfv>)=;OQ##UC)*5ITiXl+7FH>Z4ozsk7uHWjc@rY@LR3F( zo{4bwcq12-89pSu8L^|r*GK4V^*Rq(&V!MXv4PR_@%a&5?)7IQhQ57G+xY`&U>C_M z44rG7QORf|hN__d#VzN;oXHH6vR9ip^He6^v#E)Ty&;1(GNw>Jif6Q;WF6+Zrnx!h z^Cv7A6ce#*W}clb@+8v!)y`m*9sWRo_rM=gCKwNN5`~S7`qv5k2H~T=ByZp+ktt*M zOPpv2sdeq;Fn8kRHkn%ko(dRNH(H56C)?}vV+)w$nB!j1N^kA5Qo#YneB&0GkQ4M$ zj$?!Be>9sh$c0Lud?~i@9P)=0q=h_BD2og7Fw)J)GvT?!c0kRxQs5Eo)zkwr`g_&X zDQ~!=4ulF{Vm&#Hl5<6ud;}fUMHgOdP!TX8EgM4?^{lJ&XLRcM;SsW%=F*{G z!xTfG27fyEvy4A0__K;XYxonkd~ibX$7gMB5TEWMEoZK-w-tt4fTS4$%&_L;vpz>n z^K7`aklPqyFy!U1pC>bwttzsnRctV@fz;lCBgN6_ONESKQ5MI@Y7oj3;G=}79LEx zY&g@77Y|I7l-s23z`AnBCXD|Pns#w1{^-$xugaMQr7%8ES8=tChbD~a&~$~(d*MF< zLY`aZn!w3ZcmDXi&~zDJmSDjmO&CwvrN9Vdb)GR6ny%HUA2qo(9(lkAL(?_5Qy)Vz zYydbw$KGA2u!aod6UI6<{2IAgCk$_))}rQXu{$P=xtF0iaufPLUWQf$+Mi#BRs-7U z%g~&lef=^t7ib4BL#qXCAWu6sp}jMEZjN9|1}|VX1|em8PKKt97x#~Epe>2#->LA_ z%yr#5nC2rJp#w62Pe<|Yjo7<4;^jp@9gQu_NwIix{1wx{l4!ZdXU;L24^3;#K5X!` z)5w-m3phAlIpy=a#VO*^?4z-97-JARivGMgQl20%N*? zgh737u+5p{K|#2|;M&?1-^d3v0fFjIwTgY%$vTc=xj$+p5l=*}QSy#fQAi8Ib=Is| zvj7LPB!t8>jUK~NR?LPtJWq2Kaw8-Pg%07 zJsG_9ZrKHjY%AXq+d$1&pt`t*q8K8npS`}6*tM}GT)kt01s~gzyMLKPC0C_kq3wug?SrgxT>EG@$QG zhAHmL^Mv_*iFuJR&k^QHiFuGQ+|At*lV(hocs5E*lrhf|=CcyBlA5M|&WK4MhQ*S> z%|#9aqx}P8v@?u3LYNmN<_Id`03;Er1lss0o4Lgt`BLBTz;;r$WGt%J!=YE6J9h3J z+2dJypKqCGV7F&Lu^~ow$H4C010#2?pc=lK&6t;{Vb&bw>k2IMY~R_x+cN_F4l%U| zZ|%Ed&)&XaG!t0H6>iUF0-vJ7f3alyAkF7ep+O&%grV<;|8c8L*M(&3cJ6`gH}x2pUspjeXtA~ z(-WR2Dj}2Rkgk~zGNPym<0dReEhdt$W~cypJbAp+-8+ZWN^o}FLx?CKl2vwy`9>39$V6nAX< zS>Y>70FW%5}y_zOowZEJ_H;nx&-NET!Ynmy8 zN)6rx`iG==SJ}0%y78#kh{|`I%*E5B>Sz`EL#zeb|ax?kjSK z637eIX75 zM;$B)_3s8~w_;r=ZYYlbU!VbNFV|x2oY3C8STp7Kv)HGvl0?T42747w9QGU^KJK|Z zXhl~oPu(dtSfb8L9JRGKmPp&$AG2Rff1@0ona8)$%m7#P==MwRac<)i7w;xKpFP(; zvDMhZ{2$7*|BIud8?~ZuCFQ&lK2~U_t9UrYn3|7aoFBtT^}4uJE%Qjb9io-ecrmB( zUY0Hka#5Jj)s0LWvu%QsexKCNINw{VPg%8wzE$Ebyb_M_RG*A;6X$ztp{&PL=J?g| z=Xe)!(cHk95RXI_W$paxc=5|Y5>DBr>m~b+ixK@#$0GY9I%(AUc||@dspJWt(EnmK zvJA*KW+R~=>Jzh(q-`IajU+YuVTC;YS=Ex>%h4}92G{_4IS5AO44qyVb_O{&Y6z+t zj!oz*EvMy@=G0y{vrTJk0%Z721NJY=IV_(vWacxhhIh%p&9}yQ)4ZK3JSZ%>pahL&E$eujdD8wlr0&phppD}MrmanmPWe)`Nr(^5X19aKFmd7 zv}+jp;QT9=XSm`+G-|b2_3xt5VVBi3bnabr!D@no$ZBQn_eQJEYJMBEC0y9@a01({ z)jV{zcR9*gONL$N0HIv#&^eSGf5U14t(69`6qu#CiHkSO$%BiiF838RZ({?K6TjX= zK89`>%8M)_)f8;46i&QxNd_;(d4U=S<6Jb*PVgT9cC`1TNdGkc10OI}Z8@$=Co7-9 zLPclY_eN%*Ff4qt?E~TtBshX>twkeO{P1G4$?r!j!JGa|?wjL+8$xQyeE%`3|W;#!xo1 z>=HNrw!ZD2;enBUXu}@q$%bjtM+L4^nh#a+^K8a{A+y3ed>^JGjh_2k!@>d)cE2y^#VTF#x~EfwnwE{Ve$!I=*p8} zL+`n}i>Pw^fVVWhMiB zzb;~MAv6>sqZTy`f{DE36zEDW1o91#2OO{N-bTnlQ^`Tg!)-wLJ!5%vmP*zVo#l#Fc`};KjD#3V5>>jPO!)Q1Zb44A+y@jK_U!ztwy?ZZ%&Rivv0nwp!2j zt~?pBmS4b)WGz1xwN_jhi|)5pOj%1?&^gOvpnDS+`>jSedN6Q#CBWUKz$pA(3Y<2` zLBehf>Hcy8Vl3dsP{I>88dp9NT7}`0EKkWrb=S$kQk%5Z6K(rp-m3z)cIG85KN%Ed6l_ z`02Y2IF9;x_>B>2HMnF!3HRi65w!mVxmmr195eoQ{3nSfLv{`K?Oc4nPi$Qwq4`wPU$Sq}c!g1W33E*F zn>WK^%-AoJ9U@G$KACh$WK`zLxe8s@q)*7)H)Qg>Ov22muan7YnY75HffMZjdS2@& zArXQ}GV#?z4qUhy-+{RYLDZVI3111d1rJ@OqnhzQxU z`B^D^^b7O`=x%pwezy_8-c#|%zR@)Fo_9(8hG~4#XNwk}bf?_f=F@$K4s+W9XzV_N zK^W?c!}$N86jX-9!XD=U)-gH=HiZg~1*MO(V@^5NL389ird z`E^2^M-IM+Zbo0F#rGsFe8-EvSd75>;072k`A}T`sKU*a@NL8yHtB1kaN_WH9P4mU z^j}~%mv2FsV%)!)@;{@h3_8vFTVfFp}Lwa zW;7aH?~AU$+mevK#oZ%KPT#@ceFXM1c#go&5@?VHrnAPvW>f7WZeRPk*bIX9pM{r_ zAIapDOui|TBQkkdEGL#xv6<|1`U$F)6-fO-(Ms_9=$)D|%95`)KbM4f4G5lN%DhAw zns>@PMJ45G>=UhX5nd0h4i%#kvr6+Rz014U4@V>?zQSi8c&bEtVew__l2{_4tG6k~ zmKbC?*3YW*AEh^B8_xO{Zb!4);>}YLY(U(gQ9wTIKuU39u*D^0Kp+q__*R8VD^*&h zI2^bnqo;f*gzb!T!Zvd_`WvPqrz26ktzuKd7l+;-;4OJ7dO8|$H|1iJ&=59HwH3W& zW4xWm##1rFML7DtY8ByR=r>TkIwIBHeuJbOw( zWm8cE&_tnZjYefuynGs(EWE;VSVw_QumxXDE%JKG_%mr%(LP#4uR>pYvVvbEdX2?n zt>$-vUUj30EEkbx5vdjk%8t;8x2mhHWHt0MZV5}>J&DZ8Fy6dRJz=J~-z}5jp>rq4 ze;G1($DC+?o|&08zR)LwNICbF0-?y@f;;iScDfgjuPbV(*NJ_IJgJYh{KQ^>xER?W zsYbPUG1unCKR_rEH*3$H8yk?!H z<$i?sel7%I|5^lFUS=n>A0rbQE@7Uu7jCpOQTPTQiORd|YlB#o^rKO#NV!VqAtY!< zfybjXIGBX2+JjMf?SGbzp*&IC%dzo0ty;a;{j;s{MPuXhWATPFq)`@C18WlvSB5un zncVmq?ticQkmY`8_+n)E;s+PMHmm=Sqxa!L? zgTs9)#R?+8YOT73_JUDg+^EM*_7RtHB8=Jo_Kfa^?e2#EzjrtMX}fzeBn6n*ikX?M zp7VkGw3q!th#!2n2A?dKj31Ce2j3}WALREKKMJDpS^@kPSmw&OD{r8SoTSkDNiZrU zocYs*D%s3y_=!Q@;>;j}I0@8$O}s{c!2g+VMt@b1;a(qO4B2?}tqk%r;UAf({Vnx& zqc0H$S^J{``9VE6RPOJZXOe!^?dwT_Xc`?1W*Xe*_6!jpTsb*1vD($ac@F8$H_w_UuN9 zwcQ8+rQT9Vll~{TS?0F4{p__ioPM7aT6BFj;MY6UZ$p@I`-dRBJlAMWMrq576dno8 zI(~!1{!$dYLP=)StHljqE;M!zgBuHowX+ejXB&@-+t9BKd|i-XorPzcjI=yIHZ(eT zQes$+%#Qh#x7jJPEgWIl(=r)(YV=@a=z(Ue?fy9& z8^nCGgJW?SKrX^GLb0({9qjB4B%`JALK!Q@#&1UGC(JEztBHFcUwEjVyJ9s-(>BX! z?vXMmjDN?fXG=OP>rLGH*m%%t(os7EvkV86RatJXm+wNm*2a(5+GL=*@mJ%}>D*Sm z)zGY$Vx4+jnpUaSsjBF4gr5_^ucF|0l6WCLtvt*te4qTda?zGpCT^mnnHzhBz{R40 z5|?~?{2dcmX1&9#c&QMXShZ9;KfHx{lYdutnuoC?FYPBuS1X*ggnXkw0}+6kF+8!mdBOaF?JTc8uXQqTMCh zOFcMDHOkM+CFw_lD#$%SN^zYC(r*U2DOiSG7Dd(SBB?SE7=>MqDHP zx%8DjyvJt#0G6mN{%?;56)VK`Vx?FmR*N;_2C-J$C~o2i%^E&dd|>#AGW+Ml3iG1Vcq`N|C?z!= V0ZSz!C`N!a;ud=YjE65?{J%KXL>>SD delta 4217 zcmahM3v5%@^}T1u&d2$Xgpfd#8L&-0IOM}0O5@K3e`Z?0X{kR9Ezd$@nV{>av$0ek=OK;N!`P4OF8wZB%XtZ$3YH9Z5 zcavkv{2dbfZKj`N?_ZM5?11bmQIba!7PTv^Mf7AMb1EnHw&|?dlw>A0Xm+|XT7uo- zR_;hLb8aViO^&23xPxuTaLjN3FPpp=Hf+DeS(lS!a`L#6Oca0BqDB+> zd+)6Wn=D$uJXTe%V9!{0#+>t$M-l~5J<{&e+as!5^R88WdLehp+-WLLGH`F=P6=|e zhP6OQS0ltw_!@#{16nYJ(S+F>(4$t8WEzre1KJFjXTSo2G43oh7{z?eEQrU~;3vrx z?gbaqKj60%l2yV{?u1h0wt3d6xXJEjEu>=wbAW3OdD>JU0E-5C1eW8~+C%<8sKu*w zktn-O)gu94G^)nX5Xu^kXkj&?2h=FhmS|_duj96iBrN_kZWa7`5?F=6AUZmrZdyc` z&<3HaBZ*AENB8L6VKp94CQRODH|!S=V@ymv6LWWmVTYf|S`>4{r8t$`!XJu*tp)Z4 z(vI^7LEj3t#^RWTM^J7K2BLbLHyKi6!61#s`6F@e0e&7>-Mf4c>k@1c*jsT!Thxf8 z#JN8?5=-QQ_TAc0O)b2ge5v3IrS}vHTy@0v$9Xddvp{&aY9Q!DL5m@{TS5?Yp`aB6 z*>^3lgdhoZqbOjA($xh~4@%Y=l60v-@^wmYoe^lN@bNegv28i?^EV{Nq|BywurmuJ zzJa|yt4wyX{K9H^3Hv0c&*rqzQJ18XJUr23+bzps_CfB2&5i?L@e#-0@8HjSgpMJ4 zfzVMz8KKAb5MaFoMpOdFmJvAWBygmNz+sudAq=+>GTX~OoZZA0=C77FvPbh9v!5^G z&Rp&^b0@n~v@KRq#aGz)O3MnqYB68Eh`Z+V2MW1M<}Pea8}^w?67AzMI?`oyq|0LP zjXrc4edsd!&}HgWbqA?!rBxPP{wFZ2Tc$W~w2d zhE2yEyn}c0F5b<1fN%18JE=(k5e;Vbdb_md<~rg6(LF`P5*C;zZ60V3z8>4hLNTa= zu=?ZR&MH`_(ub+|v~aiENQJrys)XId`{Pvl)2JkD(#?d<-oO)v$PYjxk2GTL^cv6$ zopn@s2~=#t$$dv2!bj52?V7>kjU32~p0XOqM4n;iuITEtzs97Y3`ql$SP=jAH)PshL6 zq;n?wyK{#8)I_%HHKlyH1)M<@tiGTYh3f#`E#N<4YFXC6{!lq5SOcMzTkz<}P$Lm7 zg49_G@dctW5Gc+?h&}l=%t237XDg~gSrQsbqr93OttwWe+w4r$ zfaE=7PIPz~PE&@j)f0iIEYe4bE&m?a`BB{y(WgJC(9?TD z;R^3T>b#&{;N3_a5!BPX3#pxg+QK`L>J(IvcUX~J1*7?5by*|r{nv!7m}4QNe-S0U z&2^+M2()Y-^Mc1wJWrb z_xAv06?cMgGb+g$RRYW;U}hQaQ;PICJL?{viFcPgA6zfgklvw2qHwE(Yerq|bKWvI zG7`nW4C1nljOWN^g5{DFz?+J{S=mPnhYUBn?1#g8q_sV?u72rB*sR;NPsr75_oCIc z(xe}<%7H*W4}^m6gS@{GV|yYk?QIa;O-F?+NB@Adt!l`R6G{xI8{7r9$~u^?wzbelZci|%b*g@3`hl4d z@%RHYf3CrzjEfHlm!}SVYc2IRdFxQL8 z7Zy~jn0%`Q)hH&POHdVJ^34!b7ViKr(k-H-zflTrAm>+tGm&hDTL#Tsv09Bg1Ee+f z0C$Q<+Gq`Til^G~GVT-)HfF_}H#!{rUHh*cIrvl#m4%-iBA^&uk^KO@RMYsn!Qj{%HCaClmYMMQVqK} zznJ9)1LleXUcq{TbLF{gUvN&*Tp3<$&AbE#U6(J&vw&ddg5`M%FP#3WzPimnZ!T;{ c7G5hOftFSsM>f3YhP03>Jr6PE&6AV=10l#Kl>h($ diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..50e3c235f0fbbc4c0f6e80621e9144061bb0b8cd GIT binary patch literal 6302 zcmeHKU2ogw6{cdRTaUOnSQt%AQlgmS*6Fam`LK8yr=OZ2~=(XN}FUy6tSf#EmF0~Jn1U67vXeD6aSTh zgEN0VN2n{*hY1a%Fo;KrRD?g`MNB7>g-=p?-f9iXlO~za8L5luB?SnZ;Y%-PXYn+p z5HT{w1yX*Za#HU3+z(#*=WxE-89IXNpjrcFhdQf7ebYOxKloFpfcDSTYsU<7DsayI zBt;5176BcYP&!vZI1b^?*`+9IQq9f??j-8-MVR1#Gck%G7{wXq(O*n6QKDXFDoT+| zipN6W)J6VGHR~i*lc;QwAk{wGJ3PcsL$a4<$s)j!(iuD_AMg}fiZm9+VL2*_le3q&?zN zD!H|L^CW&1j?}1Gy(KlNn!;F0llVeMT)VQv9hlY&WVm_e@RdhZQ8oZWN{7xCDBoDB z7=Y!`Nt33Ncrir-C^UV989KtG7=tfrICfXY1b1kRS)mbH2Al!H6nurAro@lV1#c!^ z8vtlDKfuf>#@btuE>&w4Nzt3^^35py04<;= zJhPNW%F)kV%P0BtLcXAq?-5kvIDEYf1*3Wsi##hE49EsIC11Mvtd*-08E#hZnnz1j zrQuI8j>%8X<@Od$cK48{LkstZXUVKMylZT69M~7sY>vSn(>Vr_z6V}mW#DUF-??Fw z-{pKOTs7d;>~HFVnE997aXw8$ppS$WntUh&l-IoEdeo!OM;opf$oXX9p^Ru1W&TSH zu+pmnI5u_70e_mt;zgtlVmh^4yYKZ})W$iM3%b=IxwHfJhx1;zulp7Y1}-ix}dSiGn!7Y>OCdw{i^lOF*JdZJ`uNJFKDmMcL z<=weOkc<|T#}QT&y^^Tc^Elxhr9_YmzF0*d!dH-xO`_+mQ_?W;*DPbkSnDx0BFhe*#0L@yknm~A_ zX1J4(V%Sr!{n>nqkz2yS+M@+6qL3HO#`b=5tGTt)JR6Pk=G!~idc0pckj3#!I@rPJ z!*x3(DEtM$#J`~XjV%atncD)e1KonF`O*-ocNHPbbp*e%-Fz<+fbc&6)NS7F)T z&^FYty8Z1PI{0*lm5O9;st?g_ulIC7waxc1e=uWQ18@oyS7s(@Lc<;)f?vG zLkAq?nf1JHIs;y=TK05a3#A@5a6L!pUwdLW!as?blbl|;! zyLhStHTMMj+D+I1%=W=9J=&+8$B*%+p7Ym^@&8V|_(^7p7w-i-F?1XpFbT4ccj;hv zm-cp+Wj*V;CxRjjmQVL-cWY= zHEkHe%M~h_=XjZFzy>}!%RQVuJa&g&t9fL39fwbZTQhOt{ePIg3r%8QexQ^Ix2o1m z@3gO(IMCnXTZYEoZ)$?XbD!T}j!y(vCR~dYCl!;Kn1#Ovvxo_P6J(dQNd0KSIyioa zuL$ys=q~lk1Bb%d$dwnqNcXV*Qs`8(e4ihf{DG#3R}9-Hn!HRYH5z|tj8Y2ahcQ&Mig i2Ww)XQo6?kE_OCzthKS@9)|z=JV5RK&3OISfBXmYO^l=f literal 0 HcmV?d00001