From c25da55775c871f9a25f75e488b7167888585ef5 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 2 Dec 2025 16:24:00 -0800 Subject: [PATCH] Removed obsolete/lispusers/READ-BDF-old/READ-BDF* --- obsolete/lispusers/READ-BDF-old/READ-BDF | 857 ------------------ .../lispusers/READ-BDF-old/READ-BDF.DFASL | Bin 21485 -> 0 bytes .../lispusers/READ-BDF-old/READ-BDF.TEDIT | Bin 9819 -> 0 bytes 3 files changed, 857 deletions(-) delete mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF delete mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL delete mode 100644 obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF b/obsolete/lispusers/READ-BDF-old/READ-BDF deleted file mode 100644 index a4c28123..00000000 --- a/obsolete/lispusers/READ-BDF-old/READ-BDF +++ /dev/null @@ -1,857 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" -"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" -"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" -"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10) - -(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101 - - :EDIT-BY "mth" - - :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH - WRITE-BDF-TO-DISPLAYFONT-FILES) - (FILE-ENVIRONMENTS "READ-BDF") - (IL:VARS IL:READ-BDFCOMS) - - :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| -) - - -(IL:PRETTYCOMPRINT IL:READ-BDFCOMS) - -(IL:RPAQQ IL:READ-BDFCOMS - ((IL:STRUCTURES BDF-FONT GLYPH) - (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET) - (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME - GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING - READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) - (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) - IL:SYSEDIT) - (IL:FILES (IL:LOADCOMP) - IL:FONT)) - (FILE-ENVIRONMENTS "READ-BDF") - (IL:PROP (IL:DATABASE) - IL:READ-BDF))) - -(DEFSTRUCT (BDF-FONT (:CONC-NAME "BF-")) - "Main structure to hold a parsed BDF font file" - (NAME NIL :TYPE STRING) - (SIZE NIL :TYPE LIST) - (BOUNDINGBOX NIL :TYPE LIST) - (METRICSSET 0 :TYPE (INTEGER 0 2)) - (PROPERTIES NIL :TYPE LIST) - SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) - (SLUG NIL :TYPE GLYPH)) - -(DEFSTRUCT GLYPH - "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" - (NAME NIL :TYPE STRING) - ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP - (MCODE 0 :TYPE INTEGER) - (WIDTH 0 :TYPE INTEGER) - (ASCENT 0 :TYPE INTEGER) - (DESCENT 0 :TYPE INTEGER)) - -(DEFCONSTANT MAXCHARSET 255) - -(DEFCONSTANT MAXTHINCHAR 255) - -(DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) - -(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) - (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") - (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") - (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") - (LET (GBCS CSGLYPHS CSLIMITS) - (UNLESS (AND (INTEGERP CSET) - (<= 0 CSET MAXCHARSET)) - (ERROR "Invalid Character set: ~S" CSET) - - (IL:* IL:|;;| "Can we get here? I think not!") - - (SETQ CSET 0)) - (SETQ GBCS (COND - ((LISTP FONT) - - (IL:* IL:|;;| - "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET") - - FONT) - ((BDF-FONT-P FONT) - - (IL:* IL:|;;| - "If passed a BDF-FONT, look only at glyphs in the mapped charsets") - - (FIRST (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE))) - (T (ERROR "Invalid FONT: ~S" FONT)))) - (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS))) - (LET ((TOTAL-WIDTH 0) - (ASCENT 0) - (DESCENT 0) - (FIRSTCHAR MOST-POSITIVE-FIXNUM) - (LASTCHAR MOST-NEGATIVE-FIXNUM) - (CSINFO (IL:|create| CHARSETINFO)) - (DLEFT 0) - SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS) - (COND - ((GLYPH-P SLUG-OR-WIDTH) - (SETQ SLUG SLUG-OR-WIDTH) - (SETQ SLUGWIDTH (1+ (GLYPH-WIDTH SLUG))) - (SETQ ASCENT (MAX ASCENT (GLYPH-ASCENT SLUG))) - (SETQ DESCENT (MAX DESCENT (GLYPH-DESCENT SLUG)))) - ((INTEGERP SLUG-OR-WIDTH) - (SETQ SLUGWIDTH SLUG-OR-WIDTH)) - (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH))) - (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL)) - (GL (CDR XGL)) - (GWIDTH (GLYPH-WIDTH - GL)) - (ASC (GLYPH-ASCENT GL)) - (DSC (GLYPH-DESCENT - GL))) - - (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLYPH-DESCENT calculated by READ-GLYPH will not give a useful value, since it is >= 0. Investigate correcting this.") - - (IL:* IL:|;;| -  - "Is the above statement actually true?") - - (SETF (GLYPH-MCODE GL) - MCODE) - (SETQ FIRSTCHAR - (MIN FIRSTCHAR MCODE - )) - (SETQ LASTCHAR - (MAX LASTCHAR MCODE) - ) - (INCF TOTAL-WIDTH GWIDTH) - (SETQ ASCENT - (MAX ASCENT ASC)) - (SETQ DESCENT - (MAX DESCENT DSC)) - GL))) - (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT) - (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT) - (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO)) - - (IL:* IL:|;;| - "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)") - - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I - TOTAL-WIDTH)) - (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) - - (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") - - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I - SLUGWIDTH)) - (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) - - (IL:* IL:|;;| "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ") - - (IL:* IL:|;;| " From \\READSTRIKEFONTFILE, so -ve DESCENT is possible?") - - (SETQ HEIGHT (+ ASCENT DESCENT)) - (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH) - HEIGHT 1)) - (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) - (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM - (GLYPH-BITMAP - GL)) - (SETQ GLW (GLYPH-WIDTH GL)) - (SETQ MCODE (GLYPH-MCODE GL)) - (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) - (+ DESCENT (GLYPH-BBYOFF0 GL)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE) - (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) - (IL:\\FSETOFFSET WIDTHS MCODE GLW) - (INCF DLEFT GLW)) - - (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") - - (IF SLUG - (LET ((GLBM (GLYPH-BITMAP SLUG))) - (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (MAX 0 (GLYPH-BBXOFF0 SLUG))) - (+ DESCENT (GLYPH-BBYOFF0 SLUG)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - 'INPUT - 'IL:REPLACE)) - (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH) - 0 - (1- SLUGWIDTH) - (+ ASCENT DESCENT) - 'IL:REPLACE)) - CSINFO)))) - -(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") - (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") - (WHEN (AND (BDF-FONT-P BDFONT) - FAMILY) (IL:* IL:\; "FAMILY Cannot be NIL") - (PROG* ((SLUG (BF-SLUG BDFONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - FONTDESC DEV GBCSL CHARSETS) - (WHEN (FONTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY) - (OR SIZE (FONTPROP FAMILY 'IL:SIZE)) - (OR FACE (FONTPROP FAMILY 'IL:FACE)) - (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION)) - (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE)) - MAP-UNKNOWN-TO-PRIVATE))) - (WHEN (LISTP FAMILY) - - (IL:* IL:|;;| "Assume this is a FONTSPEC") - - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC IL:FSFAMILY) - IL:|of| FAMILY) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) IL:|of| FAMILY) - SIZE) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSFACE) IL:|of| FAMILY) - FACE "MRR") - (OR (IL:|fetch| (IL:FONTSPEC IL:FSROTATION) IL:|of| FAMILY) - ROTATION 0) - (OR (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) IL:|of| FAMILY) - DEVICE - 'DISPLAY) - MAP-UNKNOWN-TO-PRIVATE))) - (SETQ FAMILY (IL:\\FONTSYMBOL FAMILY)) - (UNLESS (AND (INTEGERP SIZE) - (PLUSP SIZE)) - (ERROR "Invalid SIZE: ~S~%" SIZE)) - (COND - ((NULL ROTATION) - (SETQ ROTATION 0)) - ((NOT (AND (INTEGERP ROTATION) - (>= ROTATION 0))) - (IL:\\ILLEGAL.ARG ROTATION))) - (SETQ DEV DEVICE) - (SETQ DEV (COND - ((NULL DEVICE) - 'DISPLAY) - ((AND (SYMBOLP DEVICE) - (NOT (EQ DEVICE T))) - - (IL:* IL:|;;| - "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.") - - DEVICE) - ((STRINGP DEVICE) - (INTERN (STRING-UPCASE DEVICE) - "IL")) - (T (IL:\\ILLEGAL.ARG DEVICE)))) - (SETQ FACE (IL:\\FONTFACE FACE NIL DEV)) - (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) - (UNLESS SLUGWIDTH - - (IL:* IL:|;;| - "If GLYPHS-BY-CHARSET didn't determine the SLUG width, use 60% of the SIZE, at least 1") - - (SETQ SLUGWIDTH (OR (THIRD GBCSL) - (MAX 1 (ROUND (* 0.6 SIZE)))))) - (FLET ((GBCS-TO-FONTDESC - (GBCS FAMILY) - (LET (FONTDESC CHARSETS) - (WHEN GBCS - (SETQ FONTDESC - (IL:|create| FONTDESCRIPTOR - IL:FONTDEVICE IL:_ DEV - IL:FONTFAMILY IL:_ FAMILY - IL:FONTSIZE IL:_ SIZE - IL:FONTFACE IL:_ FACE - IL:|\\SFAscent| IL:_ 0 - IL:|\\SFDescent| IL:_ 0 - IL:|\\SFHeight| IL:_ 0 - IL:ROTATION IL:_ ROTATION - IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION - DEV))) - (SETQ CHARSETS (LOOP :FOR CS :IN GBCS :WITH CSET :WITH CSINFO :NCONC - (WHEN (<= 0 (SETQ CSET (FIRST CS)) - MAXCHARSET) - (SETQ CSINFO (BDF-TO-CHARSETINFO - GBCS CSET (OR SLUG (1+ - SLUGWIDTH - )))) - (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET - ) - (LIST CSET))))) - (LIST FONTDESC CHARSETS)))) - (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) - FAMILY) - (GBCS-TO-FONTDESC (SECOND GBCSL) - (IL:\\FONTSYMBOL (CONCATENATE 'STRING - (SYMBOL-NAME FAMILY) - "-UNMAPPED"))) - (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) - :TEST - #'EQL))))))))) - -(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth") - (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth") - (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) - (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME - PIXEL-SIZE POINT-SIZE) - (SPLIT-FONT-NAME (BF-NAME BDFONT)) (IL:* IL:\; "Parse as XLFD format") - (DECLARE (IGNORE FOUNDRY ADD_STYLE_NAME)) (IL:* IL:\; - "Don't need FOUNDRY or ADD_STYLE_NAME") - (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=)) - (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0)) - '((#\R . MEDIUM) - (#\M . MEDIUM) - (#\N . MEDIUM) - (#\B . BOLD) - (#\D . BOLD) - (#\L . LIGHT))))) - 'MEDIUM)) (IL:* IL:\; "DemiBold => BOLD") - (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0)) - '((REGULAR) - (#\R . REGULAR) - (#\I . ITALIC) - (#\O . ITALIC))))) - 'REGULAR)) (IL:* IL:\; "Oblique => ITALIC") - (IL:* IL:\; "Ignore others") - (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0)) - '((#\R . REGULAR) - (#\N . REGULAR) - (#\B . BOLD) - (#\S . COMPRESSED) - (#\C . COMPRESSED))))) - 'REGULAR)) (IL:* IL:\; - "S is for \"SemiCondensed\", Assuming \"Condensed\"") - - (IL:* IL:|;;| - "Now check for WEIGHT and EXPANSION both BOLD. If so, change Expansion to REGULAR") - - (WHEN (AND (EQ WEIGHT EXPANSION) - (EQ EXPANSION 'BOLD)) - (SETQ EXPANSION 'REGULAR)) - (WHEN (ZEROP (LENGTH PIXEL-SIZE)) - (SETQ PIXEL-SIZE NIL)) - (SETQ POINT-SIZE (COND - ((ZEROP (LENGTH POINT-SIZE)) - NIL) - ((SETQ POINT-SIZE (PARSE-INTEGER POINT-SIZE :JUNK-ALLOWED T)) - (CEILING POINT-SIZE 10)) - (T NIL))) - (LIST FAMILY (LIST WEIGHT SLANT EXPANSION) - (OR (AND PIXEL-SIZE (PARSE-INTEGER PIXEL-SIZE :JUNK-ALLOWED T)) - POINT-SIZE - (FIRST (BF-SIZE BDFONT)))))) - -(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") - (IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") - (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") - (LET* ((NCSETS (+ MAXCHARSET 2)) - (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) - (UTOMFN (COND - (RAW-UNICODE-MAPPING #'IDENTITY) - (MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE) - (T #'UTOMCODE?))) - (SLUG (BF-SLUG FONT)) - (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - NOMAPPINGCSETS ENC MCODE MCS) - (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT - (CONS NIL))))) - (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY) - (TCONC (AREF CSARRAY (LRSH CODE 8)) - (CONS (LOGAND CODE 255) - GLYPH)))) - (LOOP :FOR GL :IN (BF-GLYPHS FONT) - :UNLESS - (EQ GL SLUG) - :DO - (SETQ MCS NIL) - (SETQ ENC (GLYPH-ENCODING GL)) - (WHEN (LISTP ENC) - - (IL:* IL:|;;| - "Should happen only if -1 is first on ENCODING line in BDF file") - - (SETQ ENC (OR (SECOND ENC) - -1)) - - (IL:* IL:|;;| - "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it") - - ) - (SETQ MCODE (AND (INTEGERP ENC) - (PLUSP ENC) - (FUNCALL UTOMFN ENC))) - (IF RAW-UNICODE-MAPPING - (COND - ((> ENC 65535) - (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((AND NIL (= 255 (LOGAND ENC 255))) - - (IL:* IL:|;;| - "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode") - - (WARN - "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR" - (LRSH ENC 8) - (LRSH ENC 8)) - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) - (COND - ((AND (ZEROP (GLYPH-BBW GL)) - (ZEROP (FIRST (GLYPH-DWIDTH GL)))) - - (IL:* IL:|;;| - "This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - ((NULL MCODE) - - (IL:* IL:|;;| "These assoc with the Unicode encoding") - - (COND - ((OR (> ENC 65535) - (= 255 (LOGAND ENC 255))) - - (IL:* IL:|;;| - "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET") - - (TCONC (AREF CSETS NOMAPPINGCHARSET) - (CONS ENC GL))) - (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) - ((AND (INTEGERP MCODE) - (<= 0 MCODE 65535)) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset") - - (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) - - (IL:* IL:|;;| "Default SLUG width is width of A.") - - (WHEN (AND (NOT SLUGWIDTH) - (= ENC (CHAR-CODE #\A))) - - (IL:* IL:|;;| "A is the same code in MCCS and UNICODE ") - - (IL:* IL:|;;| - "Comparing with ENC, not MCODE, to look only in charset 0") - - (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) - ((LISTP MCODE) - - (IL:* IL:|;;| - "These assoc with the 8 bit character code within the charset (like above)") - - (LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS - (LRSH MC 8)) - MCS) - :DO - (PUSH CS MCS) - (PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS))) - (T (ERROR "Invalid MCODE: ~A~%")))))) - - (IL:* IL:|;;| "Extract the lists from the TCONC pointers") - - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I) - (SORT (REMOVE-DUPLICATES - (CAR (AREF CSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF CSETS I))) - (WHEN CS - (LIST (LIST I CS)))))) - - (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.") - - (WHEN NOMAPPINGCSETS - (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO - (SETF (AREF NOMAPPINGCSETS I) - (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I)) - :TEST - #'EQUAL) - #'< :KEY #'CAR))) - (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC - (LET ((CS (AREF NOMAPPINGCSETS I))) - (WHEN CS - (LIST (LIST I CS))))))) - (LIST CSETS NOMAPPINGCSETS SLUGWIDTH))) - -(DEFMACRO PACKFILENAME.STRING (&WHOLE WHOLE) (IL:* IL:\; "Edited 1-Feb-2025 23:17 by mth") - `(IL:PACKFILENAME.STRING ,@(LOOP :FOR X :IN (CDR WHOLE) - :BY - #'CDDR :AS Y :IN (CDDR WHOLE) - :BY - #'CDDR :NCONC (LIST (COND - ((KEYWORDP X) - (LIST 'QUOTE (INTERN (STRING X) - "IL"))) - ((AND (LISTP X) - (EQ (FIRST X) - 'QUOTE) - (SYMBOLP (CADR X))) - (LIST 'QUOTE (INTERN (STRING (CADR X)) - "IL"))) - (T - (IL:* IL:\; "Hope for the best!") - X)) - Y)))) - -(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") - (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") - (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") - (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") - (LET - (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL (NGLYPHS 0) - (*PACKAGE* (FIND-PACKAGE "BDF"))) - (WITH-OPEN-FILE - (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT) - (LOOP :WHILE (STRING-EQUAL "COMMENT" (SETQ KEY (READ FILE-STREAM))) - :DO - - (IL:* IL:|;;| "Ignore initial COMMENT lines.") - - (READ-LINE FILE-STREAM)) - (UNLESS (STRING-EQUAL "STARTFONT" KEY) - (ERROR "Invalid BDF file - must begin with STARTFONT.")) - - (IL:* IL:|;;| "ignore the file format version number") - - (READ-LINE FILE-STREAM) - (SETQ FONT (MAKE-BDF-FONT)) - (LOOP - :UNTIL FONT-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) - (WHEN LINE (IL:* IL:\; "Ignore blank lines") - (MULTIPLE-VALUE-SETQ (KEY POS) - (READ-FROM-STRING LINE)) - (UNLESS (MEMBER KEY '(COMMENT CONTENTVERSION)) - (WHEN (<= POS (LENGTH LINE)) - (SETQ LINE (SUBSEQ LINE POS))) - (COND - ((EQ KEY 'FONT) - (SETF (BF-NAME FONT) - LINE)) - (T - (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) - (CASE KEY - (METRICSSET (IF (AND (INTEGERP (SETQ V (FIRST ITEMS))) - (<= 0 V 2)) - (SETF (BF-METRICSSET FONT) - V) - (ERROR - "Invalid BDF file - METRICSSET (~A) is invalid or out of range." - V))) - (SIZE (SETF (BF-SIZE FONT) - ITEMS)) - (FONTBOUNDINGBOX (SETF (BF-BOUNDINGBOX FONT) - ITEMS)) - (SWIDTH (SETF (BF-SWIDTH FONT) - ITEMS)) - (DWIDTH (SETF (BF-DWIDTH FONT) - ITEMS)) - (SWIDTH1 (SETF (BF-SWIDTH1 FONT) - ITEMS)) - (DWIDTH1 (SETF (BF-DWIDTH1 FONT) - ITEMS)) - (VVECTOR (SETF (BF-VVECTOR FONT) - ITEMS)) - (STARTPROPERTIES - (IF (AND (INTEGERP (SETQ V (FIRST ITEMS))) - (PLUSP V)) - (SETQ PROPS - (LOOP :UNTIL PROPS-COMPLETE :APPEND - (WITH-INPUT-FROM-STRING - (SI (SETQ LINE (READ-LINE FILE-STREAM))) - - (IL:* IL:|;;| "As of now, COMMENTS not allowed here.") - - (UNLESS (SETQ PROPS-COMPLETE - (STRING-EQUAL "ENDPROPERTIES" - (STRING-TRIM '(#\Space #\Tab) - LINE))) - (SETQ KEY (READ SI)) - (IF (AND KEY (SYMBOLP KEY) - (SETQ VV (READ SI)) - (OR (STRINGP VV) - (INTEGERP VV))) - (LIST (INTERN (STRING KEY) - "KEYWORD") - VV) - (ERROR - "Invalid BDF file - malformed PROPERTY (~A)." - LINE)))))) - (ERROR - "Invalid BDF file - STARTPROPERTIES count (~A) is invalid or missing." - V)) - (IF (EQL V (SETQ VV (/ (LENGTH PROPS) - 2))) - (SETF (BF-PROPERTIES FONT) - PROPS) - (ERROR - "Invalid BDF file - STARTPROPERTIES count (~D) does not match actual (~D)." - V VV))) - (CHARS - (SETQ NGLYPHS (FIRST ITEMS)) - (UNLESS (AND NGLYPHS (INTEGERP NGLYPHS) - (PLUSP NGLYPHS)) - (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." - NGLYPHS)) - (SETF (BF-GLYPHS FONT) - (LOOP :REPEAT NGLYPHS :COLLECT - (PROG1 (SETQ GL (READ-GLYPH FILE-STREAM FONT)) - - (IL:* IL:|;;| - "Any GLYPH with ENCODING of -1 is taken as the SLUG glyph. If multiple, the last applies.") - - (SETQ V (GLYPH-ENCODING GL)) - (WHEN (AND (LISTP V) - (EQ (FIRST V) - -1)) - (SETQ V (OR (SECOND V) - -1))) - (WHEN (EQ V -1) - (SETF (BF-SLUG FONT) - GL)))))) - (ENDFONT (SETQ FONT-COMPLETE T)))))))) - (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) - SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) - (WHEN VERBOSE - (FORMAT *STANDARD-OUTPUT* - "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" - (BF-NAME FONT) - FAMILY SIZE WEIGHT SLANT EXPANSION)) - (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE))))) - -(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) - (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") - (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT))) - (READ-DELIMITED-LIST DELIMIT SI))) - -(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth") - (IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth") - (IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth") - (IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth") - (LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT)) - :DWIDTH - (COPY-LIST (BF-DWIDTH FONT)) - :SWIDTH1 - (COPY-LIST (BF-SWIDTH1 FONT)) - :DWIDTH1 - (COPY-LIST (BF-DWIDTH1 FONT)) - :VVECTOR - (COPY-LIST (BF-VVECTOR FONT)))) - CHAR-COMPLETE LINE ITEMS V KEY POS STARTED BBW BBH) - (LOOP :UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM)) - (WHEN LINE (IL:* IL:\; "Ignore blank lines") - (MULTIPLE-VALUE-SETQ (KEY POS) - (READ-FROM-STRING LINE)) - (WHEN (<= POS (LENGTH LINE)) - (SETQ LINE (SUBSEQ LINE POS))) - (COND - ((EQ KEY 'COMMENT) (IL:* IL:\; "Ignore COMMENT lines") - (IL:* IL:\; - "Probably aren't \"legal\" here, anyway.") - ) - ((EQ KEY 'STARTCHAR) - (WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph.")) - (SETF STARTED T) - (SETF (GLYPH-NAME GLYPH) - (STRING LINE))) - (T (UNLESS STARTED (ERROR - "Invalid BDF file - glyph has not been started. STARTCHAR missing." - )) - (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE)) - (CASE KEY - (ENCODING (SETF (GLYPH-ENCODING GLYPH) - (IF (EQUAL -1 (FIRST ITEMS)) - ITEMS - (FIRST ITEMS)))) - (SWIDTH (SETF (GLYPH-SWIDTH GLYPH) - ITEMS)) - (DWIDTH (SETF (GLYPH-DWIDTH GLYPH) - ITEMS)) - (SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH) - ITEMS)) - (DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH) - ITEMS)) - (VVECTOR (SETF (GLYPH-VVECTOR GLYPH) - ITEMS)) - (BBX (SETF (GLYPH-BBW GLYPH) - (SETQ BBW (FIRST ITEMS)) - (GLYPH-BBH GLYPH) - (SETQ BBH (SECOND ITEMS)) - (GLYPH-BBXOFF0 GLYPH) - (THIRD ITEMS) - (GLYPH-BBYOFF0 GLYPH) - (FOURTH ITEMS))) - (BITMAP (LET* ((BM (BITMAPCREATE BBW BBH 1)) - (BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM)) - (BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH - IL:|of| BM)) - (NBYTES (CEILING BBW 8)) - (NCHARS (* 2 NBYTES)) - (NWORDS (CEILING BBW 16)) - BITS BYTEPOS WORDINDEX) - (LOOP :WITH BITROW = 0 :REPEAT BBH :DO - (SETQ LINE (STRING-TRIM '(#\Space #\Tab) - (READ-LINE FILE-STREAM))) - (UNLESS (AND (EQUAL NCHARS (LENGTH LINE)) - (SETQ BITS - (PARSE-INTEGER LINE :RADIX 16 - :JUNK-ALLOWED T))) - (ERROR - "Invalid BDF file - bad line in BITMAP: ~A" - LINE)) - (WHEN (ODDP NBYTES) - (SETQ BITS (ASH BITS 8))) - (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) - (SETQ BYTEPOS (* 16 (1- NWORDS))) - (LOOP :REPEAT NWORDS :DO - (IL:\\PUTBASE BM.BASE WORDINDEX - (LDB (BYTE 16 BYTEPOS) - BITS)) - (INCF WORDINDEX) - (DECF BYTEPOS 16)) - (INCF BITROW)) - (SETF (GLYPH-BITMAP GLYPH) - BM))) - (ENDCHAR (SETQ CHAR-COMPLETE T))))))) - (SETF (GLYPH-ASCENT GLYPH) - (+ (GLYPH-BBH GLYPH) - (GLYPH-BBYOFF0 GLYPH))) - (SETF (GLYPH-DESCENT GLYPH) - (ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH)))) - (SETF (GLYPH-WIDTH GLYPH) - (MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH)) - (GLYPH-BBW GLYPH)) - (FIRST (GLYPH-DWIDTH GLYPH)))) - GLYPH)) - -(DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth") - (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") - - (IL:* IL:|;;| "First, check if it COULD be in XLFD format") - - (COND - ((POSITION #\- NAME :TEST #'CHAR=) - (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) - 1 - 0) - THEN - (1+ J) - :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=) - :COLLECT - (SUBSEQ NAME I J) - :WHILE J)) - (T - (IL:* IL:|;;| "Return the NAME as FAMILY with a NIL FOUNDRY") - - (LIST NIL NAME)))) - -(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE - (CHAR-SETS T) - MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED - RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth") - (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") - (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") - (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") - (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") - (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) - (COND - ((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets") - ) - ((NULL CHAR-SETS) - (SETQ CHAR-SETS '(0)) (IL:* IL:\; "Only charset 0") - ) - ((AND (INTEGERP CHAR-SETS) - (<= 0 CHAR-SETS MAXCHARSET)) (IL:* IL:\; "A single integer charset") - (SETQ CHAR-SETS (LIST CHAR-SETS))) - ((AND (LISTP CHAR-SETS) - (EVERY #'(LAMBDA (CS) - (AND (INTEGERP CS) - (<= 0 CS MAXCHARSET))) - CHAR-SETS))) - (T (ERROR "Invalid specification of :CHAR-SETS ~S~%" CHAR-SETS))) - (DESTRUCTURING-BIND (FN-FAMILY FN-FACE FN-SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) - (SETQ FAMILY (OR FAMILY FN-FAMILY)) - (WHEN RAW-UNICODE-MAPPING - (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) - (SETQ FACE (OR FACE FN-FACE)) - (SETQ SIZE (OR SIZE FN-SIZE)) - (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) - (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE - MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (UNLESS (EQ CHAR-SETS T) - (SETQ CSETS (INTERSECTION CHAR-SETS CSETS)) - (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) - (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS - (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME FAMILY SIZE FACE - "DISPLAYFONT" CS)))) - (IF WRITE-UNMAPPED - (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE - UNMAPPED-FONTDESC CS - (PACKFILENAME.STRING - :BODY DEST-DIR :NAME - (IL:\\FONTFILENAME (FONTPROP - UNMAPPED-FONTDESC - 'IL:FAMILY) - SIZE FACE "DISPLAYFONT" CS)))) - (SETQ UNICODE-CSETS NIL)) - - (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.") - - (IL:* IL:|;;| - "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)") - - (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) -(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY - -(IL:FILESLOAD (IL:SYSLOAD) - IL:SYSEDIT) - - -(IL:FILESLOAD (IL:LOADCOMP) - IL:FONT) -) - -(DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") - (:EXPORT "READ-BDF" - "WRITE-BDF-TO-DISPLAYFONT-FILES") - (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" - "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" - "BLTSHADE" "BOLD" "COMPRESSED" - "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" - "FONTP" "FONTPROP" "INPUT" "ITALIC" - "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" - "UTOMCODE" "UTOMCODE?" - "WRITESTRIKEFONTFILE")) - :READTABLE "XCL" - :COMPILER :COMPILE-FILE) - -(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) -(IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR -10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 ( -GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 ( -READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 ( -READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827))))) -IL:STOP diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL b/obsolete/lispusers/READ-BDF-old/READ-BDF.DFASL deleted file mode 100644 index 927778eaf9838aafa5ba0d1b7cc9d57d42e6156d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 21485 zcmd^ndwko~mFMsGll+M72*pv1V~kOq;08A`36Bs`3i?@+BUz81k>n(%0iz@?lC3zI zIH9Evuz|D%M8FOK{UB**r?2VE?AY$mCXN$L+v&qlraVH+%xt%v?Y2z2(`jb2Tc)Mp z{ho90Pm)8@=V$-gJao@J=iK+b=bn4+xxaCxdW$dO_U+oaJChyQTmKT{{PE+?m?D_r}oh-hn;Y%*gH=cMj~x4%~Gk!TUxA z_Ke&Z59oeRr@yP?-D|I|NtETWea}E@@4ybXdz~k?>rT&AYp%N1ebv<))~?xb?b@0y zJrNN_S!~JlzC9y5Qg^L(uXBTcVCObej}omerJ6sIe_UI!OTnKzia)gkEm@*6dJ#pO zil*id;^?fIN@t$XjT-Ja~goda3w zh@Bd;$UmB^?&^*Ck|86OKd6psmm))_KhPD51w525l6M(SBq_*Bf0C9|4K4)hlqbmbjdW?87pR2ZpAfId591kS}G#s9!;qfD*h~C#_#FAX+ zME>A%UMog}fzZYvsI`K+Ipj|U^SPSN z2-=hg>V8zO8p$PS?=&KQkkOo;cp#AoAX4iK>hVM%NxhcORmqy=F-EAIKalXnLp@0& zp3hYf0?n`HFm3>>;E_TlLrFan@&OSM)v-t73Dl!98t{jD(UhuqU}JAYr(BXgBL>du z-lP%r8C1bV7I;%Wx0Jgnk&K7J0V;kLkoyXChazG1Au)G;hiuv{R0o z^mvHcM(j0FeTy6s&?j=Wh$n-g7~vSkHUO>*Y|C zyY7z^`n)9kyd*MZ%YhLb=bvmNBNkWCGANW55JS9xoJu}d54kAjwcDD|rDbEg(Y*c& z^uZ;U7pJ~QcD;w1ne6Kc(DbiF$0h^OItXVMM2@G2B#)m)U#yqP>p@vY+#ZNf>;@&$ zHIM>}%P4{Pm8N$E?Hk3^9;34xqP^bqs;1Z0oIhAcqvlm;7<-IREE$M1LNo8=&@RJD z>U)eOL};RlDb(t2 zAi?p<1n&j{_Ltx)fnUpnDnXEuO`FhvhLAIrVyQEiJrU`p1^ozCjU3L=QIcj|9!y>H zUd)6Cs0P-|@bobAa?BaMHvk=b=w$- zE83{}VX7h$Ea+s(f1sG{M>N8d8W9j4frH*BemoPKw6ZfTNGABxy+4RZ# zQnQ(p7N%nG)L8126{}76I|}K3XW?Th02u&flzLEHM5zbGRZeLDrI9ENpfr|Knm}nL zN)sr}<&+js+(c;s#a&Km1!W~sT0vP^PH6*W6;awiSyfJH2W2%;+Cf=exSdAhvi^=j z=#bG7bSZ@}!fuyVh$4)*>;Vn}SsNPjmFd7MJaMcxzW`der zj)LJPsKwzpZz@ zzP*%#=Y&Lm)|$kJ#Uxhl^&S&Ta(uEW!&5HEziFX5Y*Px8Ke!#`DVJ^W&M6qrpm$Eg za3Zi{G=tt}E30Tc5wFHzBB;SgBB;YKB5+^~5jZh`2H<+v zRIt@1?BW;sf&pLH!rwtENs`kCRjwT@fmYE|nc!Dm!|m#7h-Nmnx1fRUBQaIJ#7EbgAO#QpM4s z;&A?rGHjAzvkY5U1w!iI{+HAs?zNAbI&Dy_260PilXEiZK@h3~F&q;4IKj9_`1eu% z9p~Q({yhj@TW9BHq-KB)SF~MqZZW#L)>x6gVuX&>I7Ts{g3qA>EU8JAdcub>7fI=; z#1Ss+2~vKBK<-w=Rd8D z{3qaW2#!*xSedc1L5ux0aMcN}^XeSL^RFeI3#uMJ1<&I0e9otR{H(-uVFl!WmYCkA zgZ#>B+`oZoktj}#qU@w!TMR!hXW*l==*2fIhJP;=QyO)d%Wo{EUz9Uhvq3VwX)&Dv zlkCFcERj5K31#FnV$A*njJ2ZD))bO_^9%U?SBcM>UxE*UjOT#N?`)~y;^dQz>H^09 z4MsUQ#hHmI*_TXbM%?(98g^%fcVzC&?AVvevKn?r_O9LO4tHpHdv@QBff1M#cMiDk zOl9{0-k!>C-2gAS zsVDWt3H7DEoZ=4rJUjhrIjddP+H3=D?w=^ z%1Th$$|lKR#{P&27-tpvGA zeQP6VC8=-i1g#?Vt%IP|q`s{;*0>rexXRT;!8NXC3f8$=5J(;2^-CA3c4F?#@eFzv zN>*uKp~?0g#=pS7FY@n8{QELEX;%?J5P`L$2#_TRK)IU$5_<^&ywZs#mNK9!xmJ}W zC{rDv#csE;_$VoMYJv(@H_(sH;PnJv$>4edFJd_gFJ-(f{iUAs^bR4b(-c=%6M1m`L-FQC=^acZD< zt`XypfI_`X*C3Tr$j-CbSy-Uu4M;xM0Obx=aJuhEx=Z$6N+EPS ztqD42H4YW9UWTGoB<)ELwbJyMwc16dU&X&=be@KqWRc9>rvLY?#>MAU!!k3M*MoXY z-B`sz5QPR*{G&n{6EXu_m@vD`HV>=H`5N6^UfQ`f?6M*+Sy-gg>{9U$)^)4ME}X4H zVkX+2rQ@`IwR=1>njTM&W^S42o^%cBXUEeY)3fskMlZ~*;0LMOJ4?0nYt>d>qIoyVPt*fk6XM4<+u2*g4LNI)ksIC0cfh`~`91QYE! zbfl*ph7RzwpU`o=ldU7u;m-d0N~*wI)6i+Kg|U|y64Q(w#Aq?xXD5u7F~fZ#LUBoJ zAwIX!0-AfwXqlb7q*HX`W1Yz5A#Pcx=&*FUslNqDL)eVy&~LPIizcR&`;1nV5N>0o ziv7q~sr9dtmBA)tNVpkWj|I123z9HS<&A}?(e~!q@#vV*b~0wPogI$>I@N8opYC5X z6E;?#9S@Hgt4~CXjW3Ae9~n!8Z9q$KaU=6L5H;zCSQ}O<`nd5IqNc`8LWn@jQ1y!7aNwn5RRP2 zSach%(?-(}8_F?67DEFhTnO2d{e(J=wshLOjTWo(Oru5ZcZ=?7;9j)4t`$8h;70D% z!9k+|(?a6vvBwV@tIm!Ojv1>?M=UgIv68cv0dMR4vserx8s7GT;iT3y6VytO(`Y^2 zzltVji-y`x&2Ka6r<2wsY3O%T+1*yW9xQ{HGgNd7ik5Q;MY~1OB6wTTlPy>l$Y<#E zpy3*N1sx|URz(vRUFJ+<+YT*P6uY#!+E^}aC9r|PTM4{~!P@|8e@oV*K+NAm5z1k~jV+Ms`0ypQx+(O#!Af5^)YX2^Re-gnzh~TRtc#P^2`j;X&DuRO|xJCqxBB+qXsdax?jx{)R`ph@Nunw6aemYc!h8alx~-u|B(PDBbm;MognR#KJd3t+%xELqw zeqgHvmgK7XUat0s2wcZtia<8Ns&^7-H@guipBBLp6kPOIA^ZVObkB!GkQPC&2sVOQ zIJwk=m!5D#gkmTS{^Z_c+8n!zT;i24401Ykq49LM=W9pZg z-X*5D0_n6mxWQoDXv6}3Ak^>Of75dFNrEQW6NsP=T*F(Ei*h63bob?;D6ir&HX4ts z2bf{dWS=c{G7NQO0%!wzjLazaNUEH|uUjw0(0XGkslbK^XN@={5Ut(U`BYGl95n2RGw}$9I7m1YZOhkLx z3{h}|XH5TxIoPJwAjLAf%_>*8Sn)>#x`PT`DQ4E=`3_%vp4^G~*vmUWb}0Gm+`* zvQ?2m9xmR$UWS^RO&Lu*5KY++vT#3SG-chdj2TTYa#ojU=Sfe5eQ3u0M)pG2u0{7grt+Ym*)lxh;2wy3E!)Y$skdZ zOgRit`4uR(K!hjhG^3B~6v6G3CLV|yn*#3zc##zAmSbhJd9#BVQx{Q|Uo^cGE-|;e?l5W_sZRK#NjsC9ki?v;%RG8-cMB*va6h2%CVD zUYQRhFunyCD*T_xIZrsZsGmG1*AVI@T^^CvD8?w=J>fSks9q<%w9SnK7Zf z2VyAKvH%$_?x^v}od!wtAN4mHj!VZUm*ar%Xrk_FSWpZEKK1)^+%`^Gn7o?%q`zUp zX!vM$KAN5X@%+(qn)5JvBvR@Tj2gyi>aDGVG*tEIKMZgp2plX`xSKcXza-{iX&Uj2 zD@7S9MR~93cVW|R_%iZcVvK|G2u5KeW2D!AMx{50S+7(D)7xZctUAVEyx z@WD*t98Xzl$GKvEN8sNwNDP`VUN9(36JH_h<0Xa!M7wYWCxW=%U{(JAFi$_Q>irCU zl|a5wR~cMGZP={G>Cm8jyU49P1H5n}(BpBvkEl-*D_O=3W;-gx>``%WIC=#m|DG=e z)UP)nf$cUVu=#Y_l5FGzWP>jd!3OZ^4Fq`sRRnJC)#;>TdpBqCS%BK#F!&7uzrf%( z34EHtZxJ}o;2eQD1}T|3Cu|(TKBI0GHjbZ&V3v1XDoeO+cqr&m7VyShA;9G0#DLS7bRFJN?yRCOP zvwhc&0r$W#0=fsrh4Qw6yLJulaIanG-j>-rf)v+ofvt`j@B-y|JM_~fo!%dP$qPxM z3!zF1b`w15h4TZn8Ovkb!{dYD5!Y7-Sj)Cynv2%};;sfy27C!-l!v>oB0;G@F=*c_ zBA}sAWy%m@qy64tXiiN7AK0B5-T`mp^Es*Wxk!1A1rzU~UJVX;UQNSx*DZG>vsNZLmDZwgCsV&q;Ac61TKvi*41Sov z{RApUx&_87Vpr27#2VUc#Qi-hnbd!=2<#uBm2`8jkql%Q^Mef{pd;-0-V@N|RUYKC zFiazO8^bqGZQOVKBX;&uoI8^DAexGF{lq=sKF>5j&eqMF+q|A0Q!FKaP#93S%jCNX zI~hubA{6gC40=a0o>$mVaEOnjdDvp^lR_838r^ zwexQ!{}zpdpw=-4KAwP~8{rpMK=_3UfM1+b@GDPnJPDSls<+hc5+r=gzzn}m{5BV; z4%{s+CFs(I7z}#&Q5G!f?bI`P2-R-Jw9@3EmD!^wgFHIefT}hH;+;k!pzSj&H>1gQ zczEUKwS}biT@Y5n`aEb>4}e_K^KS>KE)WTjCms9e*{EM06a8afB`P!5#4RENYF&Xx z^wH4=gA!Yq{I8O$j!9qO7$<-gQlu@A91dZvu&Q3vcXzeWAUDajj|qbE}3%zC-?Q4>7_74u%ZkWjPR89GbwGC1etS^)Qx^2W_sjcY8> zuFy9TnrsfvHHt|<7}(`uIB#5NIByh#ZA}K*4UMxAK3)xXqX$4MR;{6MGC0>DPHdW( zWt8=8<1tJY2X8@708n?%!v=B`kfwr$qZ3a^#6dV>6^5K3YNBm3k)c;+Cm#uEn8=S5 zn{DATQ*8)QF;)iS5x@)ULyqkb{3S};|2 zbKG#PR4X}Kl6bh5^*Rb1bt<-6NR=g}$D-nCXFK+JXM1mKGYcaaVDXTp-P~QP!q5US zqY5np#uoT-C-L&ovv%#(*ENG;Z$);scpBClNbrL+!YzfMui6^jL~lzFx6Om6l6Fp= zqq8R6&_VknleD}IB;{3mmdj$0bWiQ_D+y~dmJBl5!zG4&46+VA2;N2PC@Kro{J=D_ zPpq_v^FvE|M-$Mal+ij$!Y}1u5()sL3U!vsR$ej<3jP8-m5JWYMBrwM^2-YKuqgM9 z-5@$S1AgHrin)#Iq$wc^lm~nwCidmjl}NBOfd{I1EgwC8 z!5XaXFEBV&xEUpLC%doPa)Qv!imnZIa4Pq^U}NJB-Y-#niqYz?fW8Q()i^)Ov>rHt zLH$?3@O`c>^`!c3f%yt!CI~YrFnl0U#tHM7z&yY_j}qns0>h>;S8`E>uD_v8<=%CkuHTu;((`#d$&wFM`gl^%Xenb*>7zz1)kjx!b>9J=8 zU8n?9J1K{HC+rUj<*2?RpTqYH#ASWi+$}x1JKxmBcM;sX-sj$v8opzI8;~Q_8v+If zT~aOCVc#Lo$(Pz{_Ps-UU~tBUTc!Q)+~FC2l3)_yNa>PafeBHH7N?- z%hTf@KKk$hOItz5qZ;dmZ|%Cnrhx)RNGUot0K4Y^bjbXWR96ZEL;pB<=JQ!Cg_)@o z9uO0jK(39~n!r54*&f#?l_>B-iQ@Tup)-SNXbW9zaZso$Zc}tmK|@Rj2KnII9%0P9 zpM&>{HxftcF?0@`srZ47hdpA<-Qu!9Ibt6|!3!kH7#K@R&o_S8`wBI>m*X47n`<(}F)wVMK3SRr# z%EM+4azzd{VP@Bbl2*g*;lYrYy0>8*Z^Hfv*dIK!wPlgR0J%aU-zOpngE4KT^{^V>5S(^PtaW;ZsxU8gk{7 zet#}zg9jnquQL2Cay-PXwb0J#0#!4bzDw7Dj;xdCa?v?ZcvTLPtDh6Tea0$i_b@a4 zJ@>O1GfpsLG>h*1HXD}O4;t;0&Eg6-E3P&(;>6$YCWfateK#k?)n?PskI#J0aA&Ju zBL~Vhqw%}&Im|lY1^LQ%;hSi*kjG{_A1v0v$iDIg&{{dM;pTwc1y{nnzM6a$TeHqr z03lsFu65eU;@$>YJ2hezFstB7c)jR6IQ%yh9+3Suo;g1C=3YS%zjIC*x=xcHH+Pmd>NM9?Mzw+LJ! zz{4C$CtUY5(%?z|r;A&m+W(yC+7>S3X{s6B=T^jZe`pJ0>W{F?$ww6w#9)g z-z0F7Gg1Fs1cyX`_k={Fr}cQbfiERcY>z+=QgI3&6hu?hUdHf2At-o+<&qByR}0L$ zn1>GvEdtZP7(OT{j8R@^%zsk$FAB_YR6r;Y#a1hSMO@mYhUpb2te4+odavV@FTKn3 zUe3^q%S|u8zEEDMGQGTgDBmI7P8))C{yZwow$u)HHZwc`_1-O>tI^?r61+>Qb5yJU zkIA098hq3ARe4y zGTw}h?*l@V@qWTTynC?5F}<0M?zCkICgJOG2L5-0GiAxnbyZo+Qs6|$+Z|?=s_l6A z(b4_kq0=*y&jmGS+6xUGYy4(-+?Ban@T=}ham-bdSisdiMgli0Moion9QDv3s7H8& zwdfL#9j)NuQa>Zs$!Bk*smcu&%EV{H^N7#d)*tY+9q_0JJZN@Y?DyKxz|dJ}VDfDQ zH@?O8Ohx+GSn60Qc6=-)KL|jynX%MNiFRTvB|i;7wAr!LY>}2ZIhK+i2_RbOBLOyi zXaKhcc&TN*U}KDvFiz>Ty1lP2g_rvzkxiFj0SAHkjUdfh~{H(`4RUa zoFd2*g$J0SW8LH3V@BglXgmbZqvPISs5?xaIKqC!Ed9+Yc2=WV>vyZPKe@I3(&Ge` zpCzEY)djTpi;Ypa#ep$uwDUGc9IbezkjB$Eql2>?pWI+{s1$E8)^O+R{EO1Lmc|;f z@A8D^$|9wPJSP9na7=G8+L4qV;TdaWb|GVpO7S+Mqbxf^TxM`BteiXEp7RBV7AAXFI36lRao>f#kY{~wIzK0jK$0x=CE``GtP?``tA0@C2X;@HE#7&V-!{3L9+y_Z9P+#PxZnO6JrvGcX6X#5`4T{KwVul7mc`!YPUXJ)a+NCmBkqY6^cA^x z@uK7(Uf*I#myirGk}B7Vn?=}Q#kU8`?o-{Ze7?l_y_IUfcd?_|<>vKH^ZE)m7Dk=4 zAaF|h)?77dpyUPGVBSEVnsbo__}tHmspbtTJ{V><*TOh}FAtiF;Pqx=rOVF}ny?5i z{34-QU;Z7k-{VV!W&>ZalJNNd{^Nsu%PejLS$NZkzwNt}rSZiZS&XCnfM7y_LpDCf Saf3MktQIpAJ{269pZ~w)MlIO@ diff --git a/obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT b/obsolete/lispusers/READ-BDF-old/READ-BDF.TEDIT deleted file mode 100644 index 891c14cc161b6a178923a02d5d7af4e2a55e0467..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 9819 zcmeHN%W~V+8K!(mD>`j@$@G>^d+KBoaw@TsY|D;j(kV?r5^9QMK+v|@=>j4_5itlb z0BBoTca@juzKhOu+b75q^a--)uG1$-zwZamA!$*P-FlHl=$Hil^Pm5IJI6Wn2cdtu z>R9#N_4~Vf<*jo0cDcM+E*l7*0l9y=qYk|+QwRQVn8cB)jPi%ydEs;%1+~5xW`2KE z^9R#v*&PL`8pQqS*pD(5dTFNoL6G?ag`M?D5`=1NdrfU^Y~87q?Uw7bcY6)jZnyHC z<9IL)eKqihLFA`uIF0&Q5J#!XVwL#bKtWP9jFYjK;RhUsLFlJz%8Ldn8~G9Oo+aR? zcI|GbSwGrqx7-{_^?~mNQ4pOFRh@*VlMz@X@mSu|c$)P6oB@c|lpU#voI*8C{WapG z%g8hkzVvi_9EYh2pd)QuSjtQM9F$8w@%m4^69`}4>$SwL-Esvs+tE%{ow|FV-fwqk z^LkS~w4D3xu2o(A<6dFwKb05oY4ud>JMoefKB02r1sF-C6Tcq}1ITxLDx_@sLA4=#G&EgIS1*2Z|h!5Un)gF!YfkPkmCpkS4WC0)()L&fM9n zH>{fK`Z>sU4%OD(+UC}p+QTZ63V8+{6W}KhC+#P}ghr`V^N@Pv*sjIWvF^6l=hAI` z&u&^>wTcxc->%hlvFxb#A6Q4=d1yC}RM-B4CH$4scI%8q;61b(mTDZ-o%OEecGY3M zv)*exXtf`;$f4ud59_X_a<;t|mOIw2a_WzOWjETp);d9UYrnd>`eHa=BCC{)bV<#S z>QE>`bNF6=q#iR@`y(&$`tXrT{Y*U@1z0FzF4eWACGXJgfRyWJadJxH#`4I`MRB9)_}EX3 zKny;EtfiYI@zY@74{GJyX9!g|4Z(q^Su<|SBe(F~Odi%@##xGdP+oE(?Lexy-Q1xO z8b~S^(Fc?4T;?1WSTrDiJVD;Y>IC-Ib)?8JQ^bQPZw{;~Mc$KxsU0X!I^O3Zn#L*$ zp^B&3WSSAejXL$A=5hR#m8l5ev3E)rdMXUyOkfw1AafZf3tFP8L^?t|B;b1!EPvB>xRl$?2YV!hkVH%4Rk!A=lHXOU-wjD@(f^MhI6-c^BpYqUAh4?zu(D6_> zhbWL{#fMz8a?jEbPZ2jutz4dEvEG6(&U0iwZ%|~wWP%{Zw6LbqQ9KO?c{8O@vv^{= zoGUR!M=ufrRb5(+A7E1gpQJ!Xb6OVjs=|VO0yMGi1_NsA&YddEWn8&zA0$QM`kssr z>^2KXScO5*NeoIHv3Jkwsy6bR)}f2`-2IDQ{3W6=%W-g;dwXBAY=; z3I}!IJaJBRi_`fET z>LuMn50OL6NV=9)IEv2leQv3m=V(#BXVsMUr7lGl%uJ2ukL2f)ZUl>KxfaXpmrW5! zh{e3A=QPgcJB?m~Go?5O@zuo8s;~p@>^F}(2MGT(^P)bYPLDdQ)U+cqHkS>fWPTdJ zfsoT^UO$R)Jl`e9B=i&=wX=f6sM7@pxmX;=Oe__p{kLl4`5r#3wvuOXA}ZwZDGJd? zvWEDDh(0F9oo%67HTl4l>Au<}k+T36)iFu`J<$Dp+X2 zS{wODK&l%^|%B{9*b<1CURr>evtJ10qzc9JYNg#U`qq1a}(k3xXFgxaAt}2e> zBG<*C4OKZRfVeapeL(b|PvV3pMl(JzHH(8G_P{hTHYGS$VLRC8#}_D)jc}^gCrBfG zkKGjZD{_^J03H`XoN5+f;0`FznTg;q*Be2QP%1Gyodd z4BC3YrY_91i@hy#9!xSEVi1D@q8-Ovc#U6-ba|W8RE9d1E=V{Rr8taP4UCAk)h+B= z)a4lWIGH+y&5Hp`95;#6G&n|s3h{vS$7G7D3FJV6AqDfJgmr$AQG^ssjUEZ79mP}R z`YDI5oa_W~7xT1ix9t30rmDQbAYU|=ndz3FBF+^*FS@WF?hPm*{aoDHh?jATBt1&I z8JKxg6iPB~W)9m!sOmPxTL5!igerqG3`ondi3ZKDm(L;u7j=3cKbnBRX*<3cU8k`xt3$?R^@7- zSn2l2T8=s(WVasLUHg91Qf>5xuGK_%cOZx>?;Tt*0D!v!S>?^c=7uh3hqyOzTB?oX zU(;?C1YE~{V6}Vs_FfAZX3cusskgekuW+pWUbF6~ZnNF7%-bW&-al~Fp|xxG4k?)B zXwJQ^<%n@;(XM+0aq)x`W!pK#706k$!7!V5Z>w9|YU|!T{8V%N$^m)=jG3FOcyW&? zM6cDt0zue&@3y*o`?k8XHNV%j9=ozp+zONrx7F=C+iH6Q&ZRh2?5sCo@fI&zh$Wc+ zUjTsSHxB2F;6b^-{UCDNn`M)s@nF^Y6=^?*RDb$`_??;dkZg zwbFYlcwK_H;?4n=ZJJv)k7qWO7C5bZaVe+Ur1cV;3`;!R#osT@9@yYY=}XX9#%q3? zm=4>%58$<{S1&i+X6f_N=PUPw#x3*Z1qdcnNF} zdlllZi2l7-qkiSp(Bbk=O9vHnZ`+lBcWN~2-7cn$N-;BFh&Xf{4n?L*cG_LHm`d17 zRi%TY7oVyxXRNIBU>U;$tNGA!?M9u0%j@QOxsv#|o7bk~OIh`GGDN_>N(f#pm9|Q& z#^5jKwi$yrnLigM&_Wb4=`Tjd@~u+YwGXYX(>|=Xih^=cih=__S44K<@D^UB(tQ^X zt6YSd_~a;8uy*6X={2p|zUA(Dz+(I*`a)_>s3nwMMp2LYrh8y@n35Yd<5w>3mIl0;QQG^>?&G(^PV*UvSCDo`3}P~5;4 zC(;ToA-~cPF#x|rVrujwE-gSr^99HcHIA5#1Z6wDDb^P$3wPWkF17k4AE=Q8E;lsJ zK#Y-%Em|6f#D&ezG(@NuX^pk)D~hoB z6>&8bSrHVjXh_N6iUBFj-|%-~w*&!q8;59)#u6qZwT)N)qp66iNZ06OY;#}ZkREr6 ztz{Viiizj^;U^kZ@{Ht+sei#G?*1_!xXYO6{WB1;xi-xLhfL#&oD{;-5Uo_{0}U}s zi5-{HGp05Yi*^h0N$?Y54Ebx#!MNkE8e+7XXoxnBw$h3Ss-?LCG#Uz*K^2(>aUIl_ lONW~LuSz&x$b7g1ly`S=Q?T>NKmYY-`04G^-#`1ue*uQ5HM#%*