From fd58a6c0631f98206a0ba6a85e7fe36e9c2e14b5 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Thu, 17 Apr 2025 15:14:05 -0700 Subject: [PATCH 1/7] Better handling of a glyph with ENCODING of -1. I treat it as the _slug_ glyph, instead of the _default_ of a solid block. --- lispusers/READ-BDF | 206 +++++++++++++++++++++++++-------------- lispusers/READ-BDF.DFASL | Bin 19858 -> 21180 bytes 2 files changed, 134 insertions(+), 72 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index afc91dd6e..409e408c7 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,14 +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 " 5-Mar-2025 12:44:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;39| 42641 +(IL:FILECREATED "17-Apr-2025 15:11:53" IL:{LU}READ-BDF.\;40 45780 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO READ-GLYPH) + :CHANGES-TO (IL:FUNCTIONS GLYPHS-BY-CHARSET FIXUP-CHARSETINFO READ-BDF BDF-TO-FONTDESCRIPTOR + BDF-TO-CHARSETINFO GET-GLYPH-LIMITS) + (IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH) - :PREVIOUS-DATE "26-Feb-2025 15:23:23" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;37| -) + :PREVIOUS-DATE " 5-Mar-2025 12:44:10" IL:{LU}READ-BDF.\;39) (IL:PRETTYCOMPRINT IL:READ-BDFCOMS) @@ -31,14 +32,17 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST 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)) + SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) + (SLUG NIL :TYPE GLYPH)) (DEFSTRUCT (GL-LIMITS (:CONC-NAME "GLIM-")) + "This holds calculated Glyph dimension information" (XCODE 0 :TYPE INTEGER) (GLYPH NIL :TYPE GLYPH) (WIDTH 0 :TYPE INTEGER) @@ -46,6 +50,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DESCENT 0 :TYPE INTEGER)) (DEFSTRUCT GLYPH + "This is an individual BDF glyph" (NAME NIL :TYPE STRING) ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP) @@ -55,36 +60,61 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) -(DEFUN FIXUP-CHARSETINFO (CSINFO ASCENT DESCENT SLUGWIDTH) +(DEFUN FIXUP-CHARSETINFO (CSINFO ASCENT DESCENT SLUG.OR.WIDTH) + (IL:* IL:\; "Edited 17-Apr-2025 15:05 by mth") (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)))) + (STEP (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)) + SLUG SLUGWIDTH GLIMITS NEWBMAP) + (COND + ((GL-LIMITS-P SLUG.OR.WIDTH) + (SETQ GLIMITS SLUG.OR.WIDTH) + (SETQ SLUG (GLIM-GLYPH GLIMITS)) + (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) + (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) + (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) + ((GLYPH-P SLUG.OR.WIDTH) + (SETQ SLUG SLUG.OR.WIDTH) + (SETQ GLIMITS (GET-GLYPH-LIMITS SLUG)) + (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) + (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) + (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) + ((NOT (INTEGERP SLUG.OR.WIDTH)) + (ERROR "Invalid SLUG.OR.WIDTH: ~S" SLUG.OR.WIDTH))) + (SETQ NEWBMAP (BITMAPCREATE (+ (BITMAPWIDTH BMAP) + SLUGWIDTH) + (+ ASCENT DESCENT) + 1)) + (BITBLT BMAP 0 0 NEWBMAP 0 DMARGIN (BITMAPWIDTH BMAP) + (BITMAPHEIGHT BMAP) + 'INPUT + 'IL:REPLACE) + (IF SLUG + (LET ((GLBM (GLYPH-BITMAP SLUG))) + (BITBLT GLBM 0 0 NEWBMAP (+ (BITMAPWIDTH BMAP) + (GLYPH-BBXOFF0 SLUG)) + (+ DESCENT (GLYPH-BBYOFF0 SLUG)) + (BITMAPWIDTH GLBM) + (BITMAPHEIGHT GLBM) + '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) @@ -157,13 +187,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST 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") +(DEFUN READ-BDF (PATH) (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 (NGLYPHS 0) + (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) @@ -252,7 +279,21 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (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)))) + (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)))))))) FONT))) @@ -355,6 +396,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 17-Apr-2025 13:33 by mth") (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") @@ -367,14 +409,18 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (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") + "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) @@ -447,11 +493,12 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 17-Apr-2025 15:05 by mth") (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) + (PROG (FONTDESC DEV GBCSL CHARSETS (SLUG-LIMITS (GET-GLYPH-LIMITS (BF-SLUG BDFONT)))) (WHEN (LISTP FAMILY) (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY) (OR (SECOND FAMILY) @@ -521,11 +568,12 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (FONTPROP FONTDESC 'IL:ASCENT) :WITH DESCENT = (FONTPROP FONTDESC 'IL:DESCENT) - :WITH SLUGWIDTH = (1+ (\\AVGCHARWIDTH - FONTDESC)) + :WITH SLUG.OR.WIDTH = + (OR SLUG-LIMITS (1+ (\\AVGCHARWIDTH FONTDESC + ))) :COLLECT (PROGN (FIXUP-CHARSETINFO (CDR CSP) - ASCENT DESCENT SLUGWIDTH) + ASCENT DESCENT SLUG.OR.WIDTH) (CAR CSP))))) (LIST FONTDESC CHARSETS)))) (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) @@ -536,26 +584,23 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST "-UNMAPPED"))) (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) :TEST - #'EQ))))))))) + #'EQL))))))))) -(DEFUN GET-GLYPH-LIMITS (GLYPH) (IL:* IL:\; "Edited 2-Feb-2025 21:07 by mth") +(DEFUN GET-GLYPH-LIMITS (GLYPH) (IL:* IL:\; "Edited 17-Apr-2025 13:42 by mth") + (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))) + (WHEN GLYPH + (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 :GLYPH GLYPH :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 17-Apr-2025 15:10 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)))) @@ -563,6 +608,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (RAW-UNICODE-MAPPING #'IDENTITY) (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE) (T #'UTOXCODE?))) + (SLUG (BF-SLUG FONT)) 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 @@ -572,10 +618,26 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (CONS (LOGAND CODE 255) GLYPH)))) (LOOP :FOR GL :IN (BF-GLYPHS FONT) + :UNLESS + (EQ GL SLUG) :DO (SETQ XCS NIL) (SETQ ENC (GLYPH-ENCODING GL)) - (SETQ XCODE (FUNCALL UTOXFN ENC)) + (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 shouldn't happen. The (EQ GL SLUG) test above should have caught it") + + ) + (SETQ XCODE (AND (INTEGERP ENC) + (PLUSP ENC) + (FUNCALL UTOXFN ENC))) (IF RAW-UNICODE-MAPPING (COND ((> ENC 65535) @@ -654,7 +716,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (LET ((CS (AREF NOMAPPINGCSETS I))) (WHEN CS (LIST (LIST I CS))))))) - (LIST CSETS NOMAPPINGCSETS))) + (LIST CSETS NOMAPPINGCSETS SLUG))) (DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) @@ -719,11 +781,11 @@ 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 (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:FILEMAP (NIL (2537 5797 (FIXUP-CHARSETINFO 2537 . 5797)) (5799 8831 ( +GET-FAMILY-FACE-SIZE-FROM-NAME 5799 . 8831)) (8833 10258 (PACKFILENAME.STRING 8833 . 10258)) (10260 +16363 (READ-BDF 10260 . 16363)) (16365 16688 (READ-DELIMITED-LIST-FROM-STRING 16365 . 16688)) (16690 +22912 (READ-GLYPH 16690 . 22912)) (22914 28568 (BDF-TO-CHARSETINFO 22914 . 28568)) (28570 34904 ( +BDF-TO-FONTDESCRIPTOR 28570 . 34904)) (34906 35673 (GET-GLYPH-LIMITS 34906 . 35673)) (35675 41809 ( +GLYPHS-BY-CHARSET 35675 . 41809)) (41811 42174 (SPLIT-FONT-NAME 41811 . 42174)) (42176 44355 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 42176 . 44355))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 87b9e2076c1839e153a03b33a72db37016e29bfa..afbefce3d91a894764db64c43eb07ae44b4da978 100644 GIT binary patch delta 7638 zcmb7J3wTpiwm$o$v}yVvq-mOlQUaxv7E&Iiypg79+N61$lB7U+)k@K{6wm@b?p#gb zsyI*w+AWyFL-};XVbrmuqa!afGmZ}R`%o{Bs|d(==jvR&j^gFwT%Cd5wbo8rVdnep z3}18Bzt>uO?X~w=d+oIk-Fw;b=h)5(5pVs20jIsnR#{bDI(PaMU2y%T_EoE`ceb>x zwytVl-L!FavvulBoBi%~+q5au%B@q&=S-bCr@Ty8Z4Y{HRttqUwQp!{dSDWCutJBH zHY;|4rsy+WH?TjtTP|2H!N0r2qxYQ~!;1cv{au~D+DG6yv4+x?ir2&{clGc;SZ44^!)Fh#=r_RxTyg)O<72dw>7%cs&&eUKi zQ11xU2b@fGvo!MH4T$?9etP(iSr@-guS`790g*GT#_RUkV4XgZbQrZb=H=3cdl<=+q4ldP3M2a4BqPK=!n0Z>wgve>^en%reX5*FNT&}lSc;L z8A0S-kqO?@Wthrwmz{nNTYIzEXq2m*!;XW+jA^`8_#V-e~7&3TlY!CXC$X zmU~;8H#N0U2EPjfn_m6YTSJ)5yETN_JcwY|^s#?O^m@`&4^utyuw&EuCYqmTHPdo$ z4&Mxlqto;}gD1yev|z-2K>YLc{E(g(=y{RnS{6oDqsnK?;2+s&Q>Pm#!1Vhd`n_DT7WoVk? zO@CG5G`D%3i=5sPnSnH2NQ1?2&^t?H30S%k=OVk;r6`^fO(wM$);j|YXiyDiGXC39 z6CxQ{CYCCJQc8}Q7@5CP$0K=B9f#y8bqtapsRc;33g#L?77CeN$mR-Wi8>ZF^F=EM z#vSGi1e5?UrPtKuSbz)Hr)S-T>-K5s8Qfn8hwLZ1B zR4p!4i}TdtEVY={mfnLy@%iljDu$zth<4_>*WKIH*3xXfX$9w49}4!l@;_mW^HOUr z+r?eh38Qx34zo@UIDN_@=Q46_d!D*7lh8K4-&({}{-$*<+tbI!yv$f1?;X2{y~ec# z;~fWUN$Xez66s(W7}9#24U3gPRh>BLkK~ZXk)#K4trylSA!iG5PRtR6-&4>FHVeiT z!Z7Y}m1$wub*PS8;c4PK$4yEx$65ee_#5MHi?plBA+VEP?eg*1Wy~df;1{r;r z+h127x=YpG0pe7L%O0>hLe9Vn5T!f4PAoBPp@urA2L0?3iB|IxZAw?a*f_K|e@ZOc zNU?+jyy3bk2H34SxM^s#4pHD12Aut?Sv@ZS{9VxRNtg$oVQxaoAU<9p?; z{Nuvx6a(BQdgV27oCH{jV;$hKI8Fzg6UUjcUiRlW)&ssA#|FS}@Nq>8n3*>hJr?;c zF`%nIlTu2oSNhb|ucJ(S<(Xco-_>tm=&~u+74B$h=yvzyx%y2aJt1dlSM6iKXuXP! z{c&?9;lHatnbJ@=Y-u;ZW3DGsj^gnI;CrQq013)Xqv4ySF#?Agx-JWQND$k`w`RANaq)?&f&l1`K#Dw&q`1ZYZM6JL6r_`CU+B_r7%`*ahZVk=L} zV2Jvjxpm2APMI=Oi@l#BIj)lQD8Xa@Ook3Fg@sCis~eQyb=4&KU9lk9L@x7TwrANH ze#myM?orr(28bMrO;^8#;#J%e*i|TX#01cZ4wg>6udyVe-$;@Y?bN_G0U2G`Ld+Zd z^U{;%539g~G>77Mz!Bqz-vSg$2l?BR^VmWDhsl#lPg5BMT=q96IJI0elFYp?hP=cp zrp%o6|GG0X+R3a%KUyI#7ruxE9O!#_N`ods(L@(+#$i~QTw)YLGf4f9$el_Muj=wJ zg7}`;*F*3S7SYYf*Xy@1u@%5FaN=ow&~tgs%W~iLw|+lpZHGeJ6N~;71P< zxgb2BwuoBis|1-Qh*c1A7@X(tPag+a`Y+Rq((}P29LD&Z#V41~T}GiAKj7+-FHxwv z#F1A)917Jk!4bDTGLSDgCen$bNr^bppGaKB-z+aI`&LoiZqm3oUv-Om`ocujElTPS zb5*zadT~AlJ{yqU2Yl3w->@(Fzt5Oe5KnNAR8R`)uIL#pK4t8wsH6;cw3hYFnb{}H zati-yc7CLXiU;`s6%VpX<$`P{caDIAa=xe|OzLu+>34$y=@(EEq%F65y^5m}et7yz zyHPApTt!;jLh6cAfwGZ(nMw)yr^Le2L4HmxjUe4Yiy%KN$lX*F$jyQ*5llt2bfO#) zrr6I#>yRK%2?B)!*kpD=$^|JFWE2tU5pdm*q`||Jr_D`I^Qvx51U^Se(h5Fy?p#?O z#vAA6jr>ncw8^pXk$B;5qSF$1+F0MibB{7Mk}sIwAQm#0A8?u?m~7d1SSu}uTe{yd z4cnA&IyoSHqb>sh6k|3dzZ2w?AV&pxUJzBCgeu+Y zvQl-q4z0b7)@UoT-D(Nq&%wjwD(511go;Dy0<^UOMSSW)g_FQYsurcA^a?hD?xi?Y z=^5-=ZTGpo4cOeSmK3S(5%5V3TI^i3Gu2k__u1>}oK?tpINB+@y@;&QPQzf~2ez=@ zd#JGNPDq))K!7nYo4UL%6mZr1J>_(-lWE;P6$KFsg^z@fRy@y=?ZXhXqt z+$&1AJ>J%@9JSI6>#2o`L>QpuX+`OC0>n6XQ1I~(~wTs z2BqS!eNZAsI(@?C)2%+J0=N0lQdf8j6m5sIe7E%I@(p?CBkv9`@Wt=!ijfwgt7na3 zWR0fZuT(Neb@iD2N~Q(pXS&IhVw7>EPOX<#!mAXecTXA3qS4f?m>z8#@U{(nGVrwP z=2<)rbMOq!0TvpTw)e)1t+@OK(1iju=)!LW2Do0k-~wD&RUR=add2h$;L(SJo}b{W zG=Neo=qM)9t6b58M=r(mYNJ^NZ_QzgC2Z*k(^m$?oD2U0KyIRK6WB4udfrkD@@pPg z!8SLak;}iNjL7K zpb`jSBbBzvcHEHSBqMkQ_S6V*E3{SBW9bY<6>f9+zlQW*B#0(us&iz_pz_io1##CU zgAqDEWjrzEd4n44TXi~c*g4{0I%fL`9zj?xgyX@Nq{a4tA9&KQ2gTA0z}NZg9;eM7 z2-q7?x*JvDlnE-Nwq4XS+o9fqI||!QMX9{ffhHq@@6;3Cz{n`&}Xnz71d@A1twxiYizeKlptVKkM@&(+L@ zVtRyYVkt71NS^D-1!8O>_&o+KgS?)%x*nK#aTd%+Tc-qJRK+hUz3ucL18ld(Mqcg} zseE5wrh6+(#86LdF!DMMH(IqI(Tl_I3+izMIMNw)CX#oEgQ`+LsY=fXopnSmwW!Og z)lniG(kK+9gV}0GRGHgS&~_SX%65cFcr?bV0KUaz%-W2G`$%C670=SazC)f*nda$% Gf&T-N!sZJA delta 6458 zcmbVQ4Rlk-m45SNTefVBvE_doY~z0;8?gCxVl2zD^`s{~Bgqi+Q-=m8@(&~jLc44L z2?qk3IveZ>pb3zIaZ1}Xsf`m7euA0=2+l4^S`1{*w%sNTNm{zyWC`u=+0Avl0 z-P6-On0LRqbMKuyGk5OX(V6GTzyY$S)ZgfFY`w?#@Vbt=b!#4dv`$(7Xvc=0&W(@M zt?O9Z)3LdZ<4qeoHf*eOTg{E8hQ_AK+Ui9H&%>KGJkXK%U}sN9-UAyt);!v=HZO0U z$+>2OY3}T~^YZ4*U0hSMc+PA?li8!*DYm?0?fQ<5Yu9X^l{YUh2Q(h=<#C-^lS&hZ zg8Sr|4^yH~8Ts)aqFsN^^4`7$kNy9gr~epJLel8c)Iyq}f0@M7OZskOdXUC5KmQk` zGV7Hj>G4>)EVc@|pNQ?J`El8#pWYj1HN*#L4E7JuzPJ)X>C16NvCjmMb&P%(H%=k1+bYA)h=;--ho2`Wr)j z@xibaLHfel&1zeV&BJT~!G42aaQj&!39HA%UUy17nKFo*o&~2G@ z^p%7&{`iB<7VagPyL@`C;(LsBYhR7aTGEJ*^E)WRz zMK`O8(*!=FjT^8F@y)6Uc#79!YGF2H57Hyk3Mzjmmi|X#XFdi|11jHV(HgB{za0Sv ze|$FA=@-*7=Kt#*Dxcg|xhq6|e}~wobV+ii^WW~^eFmxtI9j9CW3jrtwP`7}`VGC< z-N@z&@k{ih6sOZ_M7q9DJ#qW{1^;2ZFC|0vDGCpd;4mf+bg6&Ef6YPw!95pxe^! zZN)8(L6yj!k|NO13)b!ZzGi!`(8;q>g(XCuuVurNhfXrwQsXOdj{+w^Qh zNu+-|otlwuD2+5{(Am%|i!}4-(u{0>d8C;?X{@24O>1hJeLFvqiil9bq|XhC*J*~; z5?P28-W_A4>h2gLRj@fEeELbSFGg#y(}c|VHL1Y=OHt=YU=G3@;cy{Equ`)+X0pM(JqjLXO$$L|&VUd8VIBudKZY&U#Gc!rg6@}wXER<<#?w@>f3wy0){)r)JqNn@3{tjx&D;#rx@%B0a91=mUT z-+~^g2tM5xqgq|fUK?-bqQVxsqp;Mp^?u&xwmP+C)|CLKdfJ=~nrdolby>WM=E`B; zNCbAY)$P{YbgZz1^wKX1YsurIrlKDca*+O_co{iDYf6eOLw2+~RL_YtR1Ipe4r|+T z&E41{(%@h^N(@GAC-}; zfHUZ=(mH<+i*bR4geJw+XlgNA9OhMr0FxsXRSe4vomu0A z5%N!n5&*r9C=t*RI=v#B?8J65v^(jtiX~A0?W@@BKOC`b8%xA+4~97qtCu~*xGPBxh^*~AD;WgU7n`F`-GTD@)SOmGXwvUx2)GnZgo% zq%uDPJ*#;)C;SA$ zp)F`9t(-4mY}y1zq-Yec7Mu!{!PuNGIBCe)&kab(k^YDZ#q`0& zMb#f^Oi@tc+PzE>HN({kriilPN+wgp17=*$6kL1hGCjNa9JxUsuU(jjue@M=17@1x z8TH{@w6k7^nW=vCm$jp^Og^V?XqkTgzLH;L`J5bLGdbDE3OT7mhXy&!W(7b<3R?vv z>?!Y%UWS`8ewA5OHA@5h=L;fUVY2alRNro9t1AUcg--eBc*)AgkhQ57sswqERq~!b zTn2f&AnTZ&GuH^xDwwKh>CpxerpSnBeNT`Bg4j`#)Cn?IkYYiykVw7YdU8~bj^AS* ztCyDy{PLQ)h$*@)@Di1z74*WA+7fbeJ-mnSYcNU{qudDZU-63WHwS!!BjhU2$T1<` z$>=5USR zGCQrDca*K>WG~C)WE+@ESf!|{wb`szn%&Ku`E6WHen`kVgxfgucObsPaV>{3k8XmI zNAMWkKnJ9c*-Ge;e!)zfyer6QLB21@UO{%TSzIK*R>pBtuW_q*ILQuH&hZD}UQDBP z8C*fVerS(DJJzjv&Ai&-0w;hG)dY1FZye`5v; zZ>`Qh3Q+nPo59I>wt^FpjRx`llZ`a9sUQW1ehJrq;X$?veE23^+T`@Bcn2u>wNJrf z04{=6(O`b^4Fta}zynaES?NYDgon=D;EBbYLlQLH;CRdw#4w*ZW-&)0bHp=;ES^HE z_lK*nxllyoNKkLwcM=+>=&WXo-*?IfWxelp-&u3NZ$|@96vylSM6^AzJt+k3cKFFA z84HwjEy;(KTQT$i?+SDcU)K_4yva_59}LF!#E_2*B%RZ(KF%bnYcdjUE7@#cnaLNPr47w z1q(FtKUvqi_#!2NFw}k?8!)vbaL1-4QM)qFpR6Tn##e#YJq~ii--pd>PXeJX?y^y6 z&C?RWBb#PC(VoV@+caNRmM<&dYfpn&X=#~}J>a&DV8<95zMv(^ui0V!Uc6&?dt`XK zmUMzg3)Pg_e}xbBzt)FSHaj>ALBBcys?x~^Tojgq{G5Frq;G1KHJO0nmnF{OXHI?x z&Oww%bMtCeK9BqWhbJcCkLWZ)`#z@d)tAJsb@JincCoHS+{19}-va zPLAnB5vIta*S5CWGur?xy%;uNxX|v z$2c5gS)2?aXK+1|3!Q9b6U#MY Date: Thu, 17 Apr 2025 15:20:54 -0700 Subject: [PATCH 2/7] Removed debugging code. --- lispusers/READ-BDF | 124 +++++++++++++++++++-------------------- lispusers/READ-BDF.DFASL | Bin 21180 -> 21010 bytes 2 files changed, 62 insertions(+), 62 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 409e408c7..9b355483b 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,11 +5,11 @@ 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 "17-Apr-2025 15:11:53" IL:{LU}READ-BDF.\;40 45780 +(IL:FILECREATED "17-Apr-2025 15:20:24" IL:{LU}READ-BDF.\;41 45467 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS GLYPHS-BY-CHARSET FIXUP-CHARSETINFO READ-BDF BDF-TO-FONTDESCRIPTOR + :CHANGES-TO (IL:FUNCTIONS FIXUP-CHARSETINFO GLYPHS-BY-CHARSET READ-BDF BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO GET-GLYPH-LIMITS) (IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH) @@ -61,60 +61,60 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) (DEFUN FIXUP-CHARSETINFO (CSINFO ASCENT DESCENT SLUG.OR.WIDTH) - (IL:* IL:\; "Edited 17-Apr-2025 15:05 by mth") + (IL:* IL:\; "Edited 17-Apr-2025 15:20 by mth") (IL:* IL:\; "Edited 3-Feb-2025 19:19 by mth") - (STEP (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)) - SLUG SLUGWIDTH GLIMITS NEWBMAP) - (COND - ((GL-LIMITS-P SLUG.OR.WIDTH) - (SETQ GLIMITS SLUG.OR.WIDTH) - (SETQ SLUG (GLIM-GLYPH GLIMITS)) - (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) - (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) - (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) - ((GLYPH-P SLUG.OR.WIDTH) - (SETQ SLUG SLUG.OR.WIDTH) - (SETQ GLIMITS (GET-GLYPH-LIMITS SLUG)) - (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) - (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) - (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) - ((NOT (INTEGERP SLUG.OR.WIDTH)) - (ERROR "Invalid SLUG.OR.WIDTH: ~S" SLUG.OR.WIDTH))) - (SETQ NEWBMAP (BITMAPCREATE (+ (BITMAPWIDTH BMAP) - SLUGWIDTH) - (+ ASCENT DESCENT) - 1)) - (BITBLT BMAP 0 0 NEWBMAP 0 DMARGIN (BITMAPWIDTH BMAP) - (BITMAPHEIGHT BMAP) - 'INPUT - 'IL:REPLACE) - (IF SLUG - (LET ((GLBM (GLYPH-BITMAP SLUG))) - (BITBLT GLBM 0 0 NEWBMAP (+ (BITMAPWIDTH BMAP) - (GLYPH-BBXOFF0 SLUG)) - (+ DESCENT (GLYPH-BBYOFF0 SLUG)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - '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))))) + (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)) + SLUG SLUGWIDTH GLIMITS NEWBMAP) + (COND + ((GL-LIMITS-P SLUG.OR.WIDTH) + (SETQ GLIMITS SLUG.OR.WIDTH) + (SETQ SLUG (GLIM-GLYPH GLIMITS)) + (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) + (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) + (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) + ((GLYPH-P SLUG.OR.WIDTH) + (SETQ SLUG SLUG.OR.WIDTH) + (SETQ GLIMITS (GET-GLYPH-LIMITS SLUG)) + (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) + (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) + (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) + ((NOT (INTEGERP SLUG.OR.WIDTH)) + (ERROR "Invalid SLUG.OR.WIDTH: ~S" SLUG.OR.WIDTH))) + (SETQ NEWBMAP (BITMAPCREATE (+ (BITMAPWIDTH BMAP) + SLUGWIDTH) + (+ ASCENT DESCENT) + 1)) + (BITBLT BMAP 0 0 NEWBMAP 0 DMARGIN (BITMAPWIDTH BMAP) + (BITMAPHEIGHT BMAP) + 'INPUT + 'IL:REPLACE) + (IF SLUG + (LET ((GLBM (GLYPH-BITMAP SLUG))) + (BITBLT GLBM 0 0 NEWBMAP (+ (BITMAPWIDTH BMAP) + (GLYPH-BBXOFF0 SLUG)) + (+ DESCENT (GLYPH-BBYOFF0 SLUG)) + (BITMAPWIDTH GLBM) + (BITMAPHEIGHT GLBM) + '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) @@ -781,11 +781,11 @@ 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 (2537 5797 (FIXUP-CHARSETINFO 2537 . 5797)) (5799 8831 ( -GET-FAMILY-FACE-SIZE-FROM-NAME 5799 . 8831)) (8833 10258 (PACKFILENAME.STRING 8833 . 10258)) (10260 -16363 (READ-BDF 10260 . 16363)) (16365 16688 (READ-DELIMITED-LIST-FROM-STRING 16365 . 16688)) (16690 -22912 (READ-GLYPH 16690 . 22912)) (22914 28568 (BDF-TO-CHARSETINFO 22914 . 28568)) (28570 34904 ( -BDF-TO-FONTDESCRIPTOR 28570 . 34904)) (34906 35673 (GET-GLYPH-LIMITS 34906 . 35673)) (35675 41809 ( -GLYPHS-BY-CHARSET 35675 . 41809)) (41811 42174 (SPLIT-FONT-NAME 41811 . 42174)) (42176 44355 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 42176 . 44355))))) + (IL:FILEMAP (NIL (2537 5484 (FIXUP-CHARSETINFO 2537 . 5484)) (5486 8518 ( +GET-FAMILY-FACE-SIZE-FROM-NAME 5486 . 8518)) (8520 9945 (PACKFILENAME.STRING 8520 . 9945)) (9947 16050 + (READ-BDF 9947 . 16050)) (16052 16375 (READ-DELIMITED-LIST-FROM-STRING 16052 . 16375)) (16377 22599 ( +READ-GLYPH 16377 . 22599)) (22601 28255 (BDF-TO-CHARSETINFO 22601 . 28255)) (28257 34591 ( +BDF-TO-FONTDESCRIPTOR 28257 . 34591)) (34593 35360 (GET-GLYPH-LIMITS 34593 . 35360)) (35362 41496 ( +GLYPHS-BY-CHARSET 35362 . 41496)) (41498 41861 (SPLIT-FONT-NAME 41498 . 41861)) (41863 44042 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 41863 . 44042))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index afbefce3d91a894764db64c43eb07ae44b4da978..a9c9465664f839193a2891cb2cd91cc759f4407d 100644 GIT binary patch delta 2387 zcmb7Ee@xV682`RsjspehL{X41#N$`)jyO(!h$(l+q1+F?=iPyU2t>;ca9VAxnzGXh zbL~*MSLxm+tzWQ}I?%5!EA4EhgAG~*NV%D-KWuBcH2)~w8okf+p3&x7>;8B@pZD`T z&*%O1eDB;K3BN}Um6GDVGJU-1ku@fBUt7@vB=ctnBK`8pos=XjIyoG#O-J=eNVm&X z-|e+qstwla8e^roSRL1Xu{0>XBuV7QDy_tSqw}LNl5|#(G3lci(SB^*IQ>cBT;P1* z(?DxV)b=@4obuUPuyjm5S0{+3YwEnERTqs-wXLa9MW>|R4lBC7N@}|twQ?mEOl%G6 zqDrcwk?Z@c3;Pyz_Fd+X`2sY)G<#Aa&%8w ztW#Y{An}7aIy;q=PA8A?pBSG4io*g?=sM+aiPJ7=)j__e^fZj;( zNGQQ;_qZ%JJA}I!jQe2N#*6?S<^-q_U=olsmzITT(kOHAH0hXtqXK%F^I7JoXO0@? zc$7KJ%#pn4| zcDK@C-@@qwzDBoIaT#jr>umm7rS3u2l7i_ybWER5D7~exB!^W)?l2)I=+(Ria*CSs z4QtO-L6$UB!aWk5_QuVMx7wq}N_D9KO*fClZ>m@P_6}4&TqA%E)!OWaGSg~vA{4$U3V`lI zdS*9(G}Oe`OYr%4C?E~tJNkCBwB~#RAZZnSa@_*fEsVOcKE4~)4GxP^@S^0miSQZJ9?EC{; zP0#ObU)H>yAh_vE=>(Mo2(XK5|AxGH1K3DFP85_!l48^eYqlo z_wqnRK1rt+D=v}SYG{pCLkRs$$)LyAWfPT7tV`$P^>xd0bDuz;9zWY^6f6y_uHm;X ze}K|HwQzl292ykSpfz)mnWvCzEDPWYq{#8~gw2;uPOe+P7%}IJ_ zrtME+Q8TK$37Md;+Y9)PF4)UgoaQ;wH|!yRi>wJi+?9$gF6YvWnw(?{I9)(fhq|F= zn>b$)z3NEPgF{>jZ&i&?@%mvh4>uC#RK6=HO?K+rP&keP)X4bway`(dxeDhTwE&eH zU|9RNO71W-SI9If@XllasY(wym-AB%JM*%_;`PF!lfwAb$d4^Uzef6-v$DJ&Tp(7c}nbpILp zSsB2Wn0prJ7+VJL4l3#ngqaSurG{mR%Z$g1l!nrnU-WWM0xuv*kSSNvqaJ`My2R z_j!K5JNzLze}cSOLh=Vn(*p_$HmoliXj!)$NOADuv7sY!S{EgOE6 zKha$@S+BXnd~NP<{zUR8ia#+v^XCwGw%P2C!W>gFcToLY+d0c!jc)yt;+fL9<9(`L zjbAvd>JO;#t+LMqia#I-T;o+ex5gh(^{rap=w5$?2D3XHm%LQyvE=_Fx91vkYB;c`ZqiK5<7nd@0&UUDgG$}>ziHXwrkI6W_bYQ0G5MKxM zPQQncg@MuJ4x6gKGAS*-cMymgIW2J;KMlQabiOTIk~Kqb^e@Y)b14o(jhZ9Ne5&_P z?Ujn%Wpvf3c7s)EP^>vJ;nq-Lt#f4=T}qBDaVa=QX)s#1s%mYHCJg7>>J?`bBxH4A zgua+k;tAvTjeN#308X)Vfa7d6z#*0f@Tw3y1#A;Gqp(#7F^8psXR?^Z@=5`U)2TYS zD4k>5bzE3c*JLxPRzp?2-3%*_gMfLK?E#!&*#MIQCWZ$41D%S)YBVb#4>1_~VW2Dz zpqteK>=m#>K6U>5EseJ#Kz;1l$gD6{NimR&5z(#R|}X31mOYgl$7%U;Q{ zv76X=vud*$?Ue+oMR?DwCUOD=p38Tnvnuv#*H)M&Vd+6SotBk!qy=nF#ilkW&8YV! zvYlbbdg-e4Ou}e&dIfpM`*QkeLcFvnqk){Gy%~m$6I;Mb8Y$u#f@+nfM%7vANXN*r zSOMB@ZVT8}uey|WR4!}~Ko>I35U=+{W^{nIq`bV4UR;|I+RM|)C()soK3E$aI|#yV zApmtD9jA!~mGsixhD0(*Uo&LJ%w>T=I-H93xi}Hwy=0h?ORma%$0*DUQ3C({A$1OG zjaf02=I56NLEv!_0Q4246ZEV6xD|J@adIab;Wqsx{{u4PJz5Y!iWdm?MH#ZbL_(4O zM6`%MOOiU&ui+m`8FKcZ_y@gHI7x2OlSM6gS9$oqE~;R?CIKU^i>&jsw79hFKP#3F z^^=s$Lp$W{qMXRT=p89;(s;17ZZyD+kT)a6{+1xU4{8C@IiLYZ-{O?~_=sM?H%EHF z8o5Ebiv~z7T?Z5tpGDc&RGBQq8MISV_9|Lk}my#M< z4Pl?6;P4((o`JpbwS>lTT_fJqak|+O8`{SOS!}P5wp!9#P&fsVWE^aG>~b^ECs9QQ z@%=$+#46AxdE;LW Date: Mon, 21 Apr 2025 17:13:58 -0700 Subject: [PATCH 3/7] Handle scrambled bitmaps issue #2109. Glyphs with zero width bitmap *and* zero advance (_escapement_) caused miscalculated glyph offsets into the CHARSETINFO bitmap. --- lispusers/READ-BDF | 801 +++++++++++++++++++-------------------- lispusers/READ-BDF.DFASL | Bin 21010 -> 19752 bytes 2 files changed, 392 insertions(+), 409 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 9b355483b..8b5f99be6 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,26 +5,27 @@ 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 "17-Apr-2025 15:20:24" IL:{LU}READ-BDF.\;41 45467 +(IL:FILECREATED "21-Apr-2025 16:23:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;51| 44250 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS FIXUP-CHARSETINFO GLYPHS-BY-CHARSET READ-BDF BDF-TO-FONTDESCRIPTOR - BDF-TO-CHARSETINFO GET-GLYPH-LIMITS) - (IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GLYPHS-BY-CHARSET + WRITE-BDF-TO-DISPLAYFONT-FILES READ-GLYPH) + (IL:STRUCTURES GLYPH) + (IL:VARS IL:READ-BDFCOMS) - :PREVIOUS-DATE " 5-Mar-2025 12:44:10" IL:{LU}READ-BDF.\;39) + :PREVIOUS-DATE "21-Apr-2025 16:03:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;50| +) (IL:PRETTYCOMPRINT IL:READ-BDFCOMS) (IL:RPAQQ IL:READ-BDFCOMS - ((IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH) + ((IL:STRUCTURES BDF-FONT 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:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME + GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING + READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP) IL:FONT)) (FILE-ENVIRONMENTS "READ-BDF") @@ -41,80 +42,246 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST) (SLUG NIL :TYPE GLYPH)) -(DEFSTRUCT (GL-LIMITS (:CONC-NAME "GLIM-")) - "This holds calculated Glyph dimension information" +(DEFSTRUCT GLYPH + "This is an individual BDF glyph. Includes some values calculted for creating CHARSETINFO" + (NAME NIL :TYPE STRING) + ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP (XCODE 0 :TYPE INTEGER) - (GLYPH NIL :TYPE GLYPH) (WIDTH 0 :TYPE INTEGER) (ASCENT 0 :TYPE INTEGER) (DESCENT 0 :TYPE INTEGER)) -(DEFSTRUCT GLYPH - "This is an individual BDF 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)) -(DEFUN FIXUP-CHARSETINFO (CSINFO ASCENT DESCENT SLUG.OR.WIDTH) - (IL:* IL:\; "Edited 17-Apr-2025 15:20 by mth") - (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)) - SLUG SLUGWIDTH GLIMITS NEWBMAP) - (COND - ((GL-LIMITS-P SLUG.OR.WIDTH) - (SETQ GLIMITS SLUG.OR.WIDTH) - (SETQ SLUG (GLIM-GLYPH GLIMITS)) - (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) - (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) - (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) - ((GLYPH-P SLUG.OR.WIDTH) - (SETQ SLUG SLUG.OR.WIDTH) - (SETQ GLIMITS (GET-GLYPH-LIMITS SLUG)) - (SETQ SLUGWIDTH (1+ (GLIM-WIDTH GLIMITS))) - (SETQ ASCENT (MAX ASCENT (GLIM-ASCENT GLIMITS))) - (SETQ DESCENT (MAX DESCENT (GLIM-DESCENT GLIMITS)))) - ((NOT (INTEGERP SLUG.OR.WIDTH)) - (ERROR "Invalid SLUG.OR.WIDTH: ~S" SLUG.OR.WIDTH))) - (SETQ NEWBMAP (BITMAPCREATE (+ (BITMAPWIDTH BMAP) - SLUGWIDTH) - (+ ASCENT DESCENT) - 1)) - (BITBLT BMAP 0 0 NEWBMAP 0 DMARGIN (BITMAPWIDTH BMAP) - (BITMAPHEIGHT BMAP) - 'INPUT - 'IL:REPLACE) - (IF SLUG - (LET ((GLBM (GLYPH-BITMAP SLUG))) - (BITBLT GLBM 0 0 NEWBMAP (+ (BITMAPWIDTH BMAP) - (GLYPH-BBXOFF0 SLUG)) - (+ DESCENT (GLYPH-BBYOFF0 SLUG)) - (BITMAPWIDTH GLBM) - (BITMAPHEIGHT GLBM) - '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 BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (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* ((XCODE (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-XCODE GL) + 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)) + 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| (\\FSETOFFSET OFFSETS I + TOTAL-WIDTH)) + (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) + + (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") + + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I + 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 XCODE :DO (SETQ GLBM + (GLYPH-BITMAP + GL)) + (SETQ GLW (GLYPH-WIDTH GL)) + (SETQ XCODE (GLYPH-XCODE GL)) + (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:* 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 (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 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) + (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))) + (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)) + (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 + )))) + (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) + (LIST CSET))))) + (LIST FONTDESC CHARSETS)))) + (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) + FAMILY) + (GBCS-TO-FONTDESC (SECOND GBCSL) + (\\FONTSYMBOL (CONCATENATE 'STRING + (SYMBOL-NAME FAMILY) + "-UNMAPPED"))) + (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) + :TEST + #'EQL))))))))) (DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") (UNLESS (TYPEP BDFONT 'BDF-FONT) @@ -167,6 +334,139 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST POINT-SIZE (FIRST (BF-SIZE BDFONT)))))) +(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") + (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") + (LET* ((NCSETS (+ MAXCHARSET 2)) + (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) + (UTOXFN (COND + (RAW-UNICODE-MAPPING #'IDENTITY) + (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE) + (T #'UTOXCODE?))) + (SLUG (BF-SLUG FONT)) + (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) + NOMAPPINGCSETS ENC XCODE 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) + :UNLESS + (EQ GL SLUG) + :DO + (SETQ XCS 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 XCODE (AND (INTEGERP ENC) + (PLUSP ENC) + (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) + + (IL:* IL:|;;| "Default SLUG width is width of A.") + + (WHEN (AND (NOT SLUGWIDTH) + (= ENC (CHAR-CODE #\A))) + + (IL:* IL:|;;| "A is the same code in XCCS and UNICODE ") + + (IL:* IL:|;;| + "Comparing with ENC, not XCODE, to look only in charset 0") + + (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) + ((LISTP XCODE) + + (IL:* IL:|;;| + "These assoc with the 8 bit character code within the charset (like above)") + + (LOOP :FOR XC :IN XCODE :WITH CS :UNLESS (MEMBER (SETQ CS + (LRSH XC 8)) + XCS) + :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 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 @@ -302,11 +602,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 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") +(DEFUN READ-GLYPH (FILE-STREAM FONT) (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 @@ -393,331 +691,17 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (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 (+ (GLYPH-BBXOFF0 GLYPH) + (GLYPH-BBW GLYPH)) + (FIRST (GLYPH-DWIDTH GLYPH)))) GLYPH)) -(DEFUN BDF-TO-CHARSETINFO (FONT CSET &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) - (IL:* IL:\; "Edited 17-Apr-2025 13:33 by mth") - (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 - ((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) - 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 17-Apr-2025 15:05 by mth") - (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 (SLUG-LIMITS (GET-GLYPH-LIMITS (BF-SLUG BDFONT)))) - (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 SLUG.OR.WIDTH = - (OR SLUG-LIMITS (1+ (\\AVGCHARWIDTH FONTDESC - ))) - :COLLECT - (PROGN (FIXUP-CHARSETINFO (CDR CSP) - ASCENT DESCENT SLUG.OR.WIDTH) - (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 - #'EQL))))))))) - -(DEFUN GET-GLYPH-LIMITS (GLYPH) (IL:* IL:\; "Edited 17-Apr-2025 13:42 by mth") - (IL:* IL:\; "Edited 2-Feb-2025 21:07 by mth") - (IL:* IL:\; "Edited 29-Jan-2025 16:28 by mth") - (WHEN GLYPH - (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 :GLYPH GLYPH :WIDTH GWIDTH :ASCENT ASCENT :DESCENT DESCENT)))) - -(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) - (IL:* IL:\; "Edited 17-Apr-2025 15:10 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?))) - (SLUG (BF-SLUG FONT)) - 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) - :UNLESS - (EQ GL SLUG) - :DO - (SETQ XCS 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 shouldn't happen. The (EQ GL SLUG) test above should have caught it") - - ) - (SETQ XCODE (AND (INTEGERP ENC) - (PLUSP ENC) - (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 SLUG))) - (DEFUN SPLIT-FONT-NAME (NAME) (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth") (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0)) 1 @@ -731,7 +715,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 RAW-UNICODE-MAPPING FAMILY SIZE FACE ROTATION DEVICE) - (IL:* IL:\; "Edited 5-Feb-2025 15:05 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)) @@ -781,11 +765,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 (2537 5484 (FIXUP-CHARSETINFO 2537 . 5484)) (5486 8518 ( -GET-FAMILY-FACE-SIZE-FROM-NAME 5486 . 8518)) (8520 9945 (PACKFILENAME.STRING 8520 . 9945)) (9947 16050 - (READ-BDF 9947 . 16050)) (16052 16375 (READ-DELIMITED-LIST-FROM-STRING 16052 . 16375)) (16377 22599 ( -READ-GLYPH 16377 . 22599)) (22601 28255 (BDF-TO-CHARSETINFO 22601 . 28255)) (28257 34591 ( -BDF-TO-FONTDESCRIPTOR 28257 . 34591)) (34593 35360 (GET-GLYPH-LIMITS 34593 . 35360)) (35362 41496 ( -GLYPHS-BY-CHARSET 35362 . 41496)) (41498 41861 (SPLIT-FONT-NAME 41498 . 41861)) (41863 44042 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 41863 . 44042))))) + (IL:FILEMAP (NIL (2496 10330 (BDF-TO-CHARSETINFO 2496 . 10330)) (10332 16202 (BDF-TO-FONTDESCRIPTOR +10332 . 16202)) (16204 19236 (GET-FAMILY-FACE-SIZE-FROM-NAME 16204 . 19236)) (19238 26049 ( +GLYPHS-BY-CHARSET 19238 . 26049)) (26051 27476 (PACKFILENAME.STRING 26051 . 27476)) (27478 33581 ( +READ-BDF 27478 . 33581)) (33583 33906 (READ-DELIMITED-LIST-FROM-STRING 33583 . 33906)) (33908 40279 ( +READ-GLYPH 33908 . 40279)) (40281 40644 (SPLIT-FONT-NAME 40281 . 40644)) (40646 42825 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 40646 . 42825))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index a9c9465664f839193a2891cb2cd91cc759f4407d..66bd515f17529d045980a8299da8adaa85db722d 100644 GIT binary patch delta 7585 zcmbVR3v`r4mj3JS&YOhLGr zX7-#Vq`q6XZr!T7b?e@$KSPhPCr+@#3!+WI);m^3cHG#t`o_-PyH{)5cX#dV>)v(K z>KnVZ^>y948tFZ|x_0hb9dJ3D91Ts)RV%Mvk{R5wXXn-~`}ey0y6jtbc6ILV+Gej= z;&9%y(@|4hbG3cRvK2M8E3U4|Y<32{SBm*|Y~R*-YbA)=oj2KbcK6w_N9AOfi3j7y z)VVtZOPe|JcY`K#YFwB^lX;%lYhIg^6+b$V(cJED3~AgS6uVNEiA&~kkx0oGvr;yS zv6R<+e{3E{2kQ3yzm_`sQmTz*?1L%jnpxi`K29s_khM%*;xq$u49qpqVxZN)Jbhn& zT!1wG#D%Iy(F1ihZI-{bV}3wAymegzXy-W35 z7wew6`fV27!*q|SI4*M0M?H%4Hjio`_$={L4FsQ~y5YSZ!+Sl3_j(NP^%&mkF}&9U z-V6Prx~ITUU^B4Tz*2H==>F$_(&D0ktZ+d0;BNbztu6;`B<^-DH64P6beF%8H-Yo( zZsHxGa^_KjV^kieGA{1STb>0yQZ_&b@O|N%v9SGAEEXR~CB2TgkQ?wd2&G9@o1yg) zoI)dS>qt%^ro_mS@_-$Z-gH{RhaxvWzg_tz>8<|*opYqV$;l?q=H(Oe5lBswQh)N0 z{7&4SZ<{)w8Yz0vIq1YIG`-^|I+ zzLIPEhgd8o&oRsVZeU@V;)2D!>H|2+if#h8iQl^@OVvcXdKBg;Rr^nyH+n$XPm-vkW=Q5?fGDS$KIuJIa^4 ztxBR5&|_5-K0vS4oZvY?_^qi4ZaK!6^IU6sg6AEJ0%^5oCb$im1=eW^UW!z)H7CL6 zAZ54aCU^x>negN2jG)krQT@>(QIh+KuFiO7{eD!&D?M`0_FewEnQ zAo(Pb%aJ@uWF3Y!uFe_!&zltBaGC;gWu`~PyDI{$QB3x%*6OL)elE zmQ&8#ddI@nL~9s4$>0=+?ck%_K0d@t`?>uYFV>B=Qk1jvQfRaH^U`y}MGdv~!R}b( zNCRm3s~xDaArs3)Bw`DfLRT$3ClLvkgR@67uwiIKxr@(X$g%Ts7OqI}ay7ibm`!+5 zf*W*kxbiYx8m>yxyaKk!$1A=WAN2L}if8@2VtmjK)N>xbXe?a)bStkMA8hUCmCty2 z)%c*dpI4pZ3o62PJa8(^W@KV7FICTq-K*@;fTzPVya&eQ~ivX>f?CZcln#zKtkQ8&jDZ&I%ZptY=h<$S0KOxV%6%BD7$_u zwRMK{_9{u0pz0xbK&1s-ZC+=i3+ub7Z7Y&H^eTi7-Gktluv$XOq?kft>W9>zz9-=& z2?+_KdMD~o@6i_`Y?H8DLbe2zfPE?93F^pBNjNOwZVB@wWDqD{O8A}lY_)xk8PqdR ze4tR<4(YsmoBfLISYf|2C}yo$kr_NLBaFIAbgU^_q?XkiUb@Zw4fyp5_xV)ARbvt0 zq$jYNhbv4)I@!AOAgh}y3ePNR%oiq zHV%1)3n;d@&ns_}OFz@wIzHGNYo!6iOs7{3nnkCxQDvJ&K3^QoM^i1q?b!@>Uw>l_ z)+@>GyO7M&aRb#Eu+Lf84xZ$PU*x4BFWBL0;9hzo0+0PWXfiiz8v474CKdK{Fb;=?fD$NB-NX3GbtqrI)s8N`v;J-|(qT=YY>iRO0; zlFNwfL^6w}%FKEYYRY309@HIJJE%MM>5ho*XxAMrdSw>yRLpcyMLCUqAJZ41*f$d5 zFxAv1*E)^7Re1oa=>Z;c;t{){i( zBAmxIR}+r%&fRMY^%F=9#RpW)yIbG*egdU>!t;DXB~ zCgTBfOG9H2UOIBkxK!nH*depm84O|NJ-rO!4IRC}xVLWEM;mp$*x{O;&2aW`2(dgk z`pWG8V%H2IeHA)`*X3^s(ZxvKdyb%z7oo-E@{;-=QNLSz2#$&`=FU#vm_wCLQC2=5 z=GaoclIh~E@~5)&cH^*Q@31kHjL+HJn-QgZMsv z#!d&(Co_n9J5&DN$1OHl9Z^1kio4H5GSP@5F{1p+4;%P|U+R3g$3H$8`Aa`)8jS3R zkznw^#KYfN z;Q?5m*H|CSmglOFC`Z0M+!KbYy9KNPw}_w{lcyytPP&g3dto6zxuVr8Tk{fL@sPWd zd55&>dFR~T)`-n!gACc84f(>zkY*!8k{8IpRtRomqH8Z3KyoR1Xpjfcg-r5teH=+U z^&v73L}mnBKEBT7XlifsY8dS>n3(8|z)(nigXB>qBpN8$Q%KS~O$vOUxKR?O`!@R- zN?d<=9JNeeiXFcq4u!6t6G<6$jclyO>8^KDR8(HR+^jqaeEI#t83;H#K#%eWisJQ{ z-i+*c6G}(faTywqFQm>-+X$YqLYrw3^e{C#@pzi%!2vh5x=@p;2>1-&8K!AKrMT9% zJ0V6XCVA672_#$rpk(KeyqU;nk?bS#IV7(mGJ#su4Mbx%|N6Auf&XSuoFBwg)bW^g?6zQ8Z?8NWti-E=O%` zU7dKYvM9d;=BIv6BcgMue=SLIv2s@a5oE~SqP7sV4Txd~FGYqjqHjRBAEy#*ZwR{9 z${jx<9&pUhySM=5m4kDr+r>gd^Di7u<`L;tnihv<_BXV<>=Ba1bHENs&fUa0hMZlJ zLsv=VD00?Ij+bPPh!a&cGY-a#04#@apX1Jy%9s4~*?X;+S ziQIcTsW`onYPU5Ld@hg2=d-BxnfS8$QFhPF-rBMX(zQ8`p9Q>{PYao8vFsB%v26Dm zY*$W;=WDGQd)N}A_RHGJst;f$e`>u;tE){#r1>M7Ap2C*EnU|1f6u-yKEUkr4_>Ek z#@?!h22f|7(mRZo@g1WhOH)iyN|P5FVV%3KCIJ-$^l}3io*93IerJhMKZ1O^*XA3Ecf~28d!Y4f#)szZB^VQ`A)93*t!){!RFP|S>g6sV`jYQ#enB>``5@b|n z_sd!ozO$Gb8aBw!QadG+u2~A5YdJgCj@lGD*KR2zLn58)TFJSJWRC8K`!y?-tUO}j z1~G*=@TfvX-(c~&zYRL7p~Q{I-=gWO4sHQ^>(4I z$-jHNm8NUt$jX=*`lYD7@qvY6aPdr0z2Y%((Ys;OMl;O7xHmxfG~=JQ%nhi9U0Mzv zmfpsLkde4wZqxA@)O6J3AUv^v;N%=gT`4qEwfLYT^PmGF^`_BBeLluEiA(-+`M&Cl zj-lQ%9sL(RdC^-x1ne7ChcI&}ry~IhC-K!9k)3fxD z^qkH#)GfcAMUgZ^2%=R%MW}7ondlVCD0Wj@ji@rZu}vF_@^KxlgT9W|HYXJ;ZI zVG=58YXFlAbS|Q`Sg~r|1tMEPaNKs=mHkAi1OcVG?tW`qt5uh!)qbnlbIyH}N!0yz zA$jNAbAR`|bMHIn+;eY!x}OdFggr7N?r*&>*^q2rDX>+Q9RsvWm)uCAL~x4>SzU~%2t#dY(|O^&dCEG!bcbMuz<9b0F^06Prm z?6%_&Xr{&tKbF|1PP>4-f5hkGp^ZR?e_#ck+5*{hmDbGnTfr9 zO zq`KL^vc)~35J!_FT-~rTrGX#I7^?WT`R(nq+%tA<2H!H-SUjHK2H`OZNll48Dwt?& z0Fz-B(37S2n01vK=tF zfN9WLgN>lCL0gfA?i(;qithl#ct8YP@Iq%87C#O6;TT;H=*X6k*5V39JTCZ{skbJ2 zdL{Nj0F6VV+B}UBcN!p4fQNKIqXe{#sMw!Ed>;_z5f!y*9gn6EKhP0U$0)>s6yjn2 zvAMAJu`%}d>2H?4l2-e8kMK$0PQEbP$sXZ%XIJJwnb@af)&CN`*`m~sZ31=1H| zaQ_Lo9Ktoa!p`-Cge9nr#5%XwW4Cp$-(p|a(Y@}@Zc5V4-CJ*u+1Gd8x?$6n&f7NG zJ2%~Y+vZz4?f{+^<-g=qf8Ep5qkGDi-*DY8`KpQT_(!8Wpoqr4K7q&^a_!CI(AuOVV3Phfw{T` zUojY}znvxe(pwm_p#tRtV>v0Z@eJFnicxFJEY$x8Rj%rX5K}Chpk|0rKR;-($H&B; zk7Ccqgb!mc2V>8t$DU7*J)a(XK0Wq)`gY{gwD!S{Zbxx_ zKT3ygiW>>xet~Oh)*~49TMUjIni+?VELRYM7<;O|coEW4u%$H@i{$P->@Q zRos(5#hluf*i61D-xg={Q+CV(9pG4KsazvDAGRO`m^~Vh-cH%V6reh7MMJ|1t*L45 zND^aCv>X$@YNGommRQvB=LGwV@L8HT>T|NL*+2izFLK#xgqgnbGQ-9Py5#3B~I5jB)V z=O#USwYiu=d_cXBLjpkkkVdpzV1kfJw7h-VT+IUcL@PkfYBeV{8*+u#oTN4txgu+B zQY%BwZnY$}3gpVIc}Z<1ax<*fq*jC6Y->SM!=&ItQ|cy<%}e9Si{GT@IY>(BxB#?r zk>r=?`8GY@q32~jqp&8fj7N>d_yI6=!6(qu7K#lBWE)V+ABbI#>>I?cL-rW4Hz7-* z#yXJgMX7T679#Hih`cS!i%YV+xJcy%yOB+z&QyKDmdeFedLRjI%aTcuE#>b|o|2bJ zb+LTm8!sRi`Jn75tsMPHznS!WdeUp-zqQTa+iXpfgG>b3M5uvb##v6N`y&q6B)5tn zAZ{qyoQd|ZE$THwWAKAOlH4IQ?w!&W9|2fI3xl76G@u1`zOe2r|5k5;6;NI^Cv_(K zMai62j_Zu+M1%YMOR;BGRa1{{#q`CsAL^yQlF{e zOm?yhSJ1MFu`B(Di@Q9U5R72$(MI9Fv=xuRPj^uAdDUuE`4aq7gte0el>?@4R z&O9kqMHxVqzfep06i#Ltu24t|p>UsQFGM|mFRG9{CCPqCcEYhTGvsRVJDe`;-AF$E z0J1lW8YC?;(=_P`N0KrT$3DUp6Ha+mctNB*C&>Xxb_(BS;cXS(CgEKwyz_;(SX5a> zRko;7MHRyVA13-Hdp3Qyqq}pxeaylvwr>kVAVu^*+9gjv(#h)0{0+Bh@Xg9!vBo~M zWELJ${jOkh#Es2jn#L~F|4-0kaQP$1KMnkNd6cbgZE-rnt}X)Z=4Y!)v)1NPV+a4D zs*-VDI&%rz!`ICGIX_eTIeVV}x~?$}>-r<9btOOZfKZ1!H6pq z#J(MYaU>-e6E#kTBxx_7H)%-0NJ4NKIqH1p;e2xI%&+$7fZqtdwK7? zrz={i$Y9Si(aNS^`hwS0w7E6E3(hS>VbzxN;QS+O`OyW_jq$DE?F=@9Os8K9w}xDB ztihkY>~M?U<8)Oos+)J+Brwu|%ags_;cs9d2z1yKcBgj^x)Yt}Hk|0~^Xf8OhF1 zCbEP37dx1b?^^8f9Dr{2obVudg0PPwyIV@`C&_-4Y>|=}Nk~nbl=w-K;PxeT`FjAV zd`5ERWs>h3+_2;XTl<;{DrnT1Z?4vY`B^ybaq6c@JwWWSdr8HiRWP?q>18cV)bnS0vWvQL{}LLVVz+L8S@)y@CE+U`h|`E_iPp=`k1|P z*BZ55p9+yL4u};p&JCG^WsVGk5mM?3{^Q0{HkrTCI4w?|N4FFV<6R}I8M)g+((pT! zlJ)F7vKb`ZiPnFXX3xqz`Kfe5S;^2BynqZG@%)uH?T|ph3Pj9M>Q=M5Py{bZ$qwabgu0>$kB2l|UMf6`hRli4z zm1ICG|ME(IpjRtD71YYF^al;V@?FLD2~*+KDj0EOc!O4?LcPUL72D$lP%RWCwIW$9 zShWJJ=&bh))CfgTBNQbM|4z%5#wbzS*Pu3lc6|#}v%wj{=O2m|CcRprUPQq$AP@A# zU?p%BVze6N$w(|(0q;sLNfC=ql`mAIWvP0~4vUmp5?CmmS8%8uN-ZnYk~%hT$gh?0 z(vr&6Fq4Y2ng#8%Ay59nMq+#)6 zbmE;Zeq+X~y^|N`AbXgK8ubaPX;eW~jOrjy8pQso6t=8Dv_nhztL)&#_TsoYeI2!S zM8ujJ$xXx&?@@W9K1(7jQ`D!ZOi_1}>#FxlayykN>Uv35NTDWMW?3OgP3#5PdPb7R zB?%M}lsP0>AW4-Z#oShEX9nJ0y4bw>hcdgV8T^UTDMjq}G543SQnAz#pn$#{$g+~$ zQ+6}|V`-E>Th_r$JZIXnVpGz6T8+6+o2ZZml$xw>YR;wBao#`8udX)m_og{jTGKgk z+|1cuv9fE2YmuO{4%@VYtMie4PZT4eBcO`$#?IoV5MCK*(EM~sfwE&_4U(tDWF(J( zx}0{8-|uR6_-h=YW)yy(miHL4bbrDgA@*-c`~mWGK)9DzN7u4sCJ-JpPr~d|1q^6rKriqYW)~9&X#JTZ3>H(c)@E z!TpIo)#FFbp6JUPsa-)AmaN;RFS{9b>_8~QaGM^N+NKxK@lkc)xDWK2HiDOy^#_lz z<{RO)O3CVzKKROfR)q#%{+^1ZEW(dh6c^d+wOl$KLBzr7Lz7<~;!LyH_V&84Gw%7Kh&lr2rBV91;lx=b9ipT%OdPw0p|o#qa`q;sZ|esFJ@TcYGFD zs90h*L0)UmfSILlV&%QBx&cj6uG%4x4338IxV1E$Npf>92vKXIEWxbT3Ev#ys}yiO z>dTP#OKbE5VYrKz%xY&R_ye;-@sx>H`0g?IX!=Qa;0V(+3ybD?KLvIPUKwb4da`ft zkM(p$tpl2Mhu?sQ@<;tDqjvAD!zcanpuXSVb!Cr#qbGNJtS5G=;pnw~I4NH_YNzwN zU!KF=n^;`=2fqe4jyUz?5#<~-+}#EO#i~K@i@?DnN?$sbXg#3g}K3d4#fL8E8_prZv_&gs2Ud@!5m zyKtHFU=*DB!#>>M^1wJBFRkf-6Ub2Y+?*Y1u` z$gvUzEBg?N7iJp42B^-BvjJI%4^*L4U11}#G7lOCBaARO9U<%(hLflPj=soW1v$GO zxetKLaNW@Az`UxyPm1>;OXaJI8A5F#jksl~bgWXb8c?aYRM*rXFH3D4r(CAJTsbN{ zcfkuSo}eeLkF@lXYuUtfMIi_;(GAdNe=O~)=f|7vbsri#~^ zs);YEUBb@rEwwZ2NWx?q>Ljxe!tNw?lz^5-?K~jXa)Wy{Tg#(vTm4(t!ep~rv@n>Y z1*Odc^rtVj+fYqY-z)R$zA~^qgDPybXjip)S2d)`=-_d8fUzjg^p;EK>yE#OZ!Zxx zBo?`4eng7!6D#M$A|$Vq1fj}lf+`0kW)qPMonm#9D3&giLGGg*nkXXj#Ihq3b!Q_| vU4pC;60{NjpaBhD=(FbE1B^0AfP3|0 Date: Wed, 23 Apr 2025 17:26:52 -0700 Subject: [PATCH 4/7] Update for new issues found by Paolo Amaroso. Allow and ignore COMMENT lines preceding the STARTFONT line. Add error checking for extracting font FAMILY, SIZE, FACE, etc. from the BDF-FONT object. Add recommendation to documentation to write the DISPLAYFONT files to a directory separate from the system's IL:DISPLAYFONTDIRECTORIES locations. --- lispusers/READ-BDF | 101 ++++++++++++++++++++++----------------- lispusers/READ-BDF.DFASL | Bin 19752 -> 19899 bytes lispusers/READ-BDF.TEDIT | Bin 6302 -> 6848 bytes 3 files changed, 58 insertions(+), 43 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 8b5f99be6..7b10d4139 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,16 +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 "21-Apr-2025 16:23:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;51| 44250 +(IL:FILECREATED "23-Apr-2025 16:34:17" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;53| 45086 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GLYPHS-BY-CHARSET - WRITE-BDF-TO-DISPLAYFONT-FILES READ-GLYPH) - (IL:STRUCTURES GLYPH) - (IL:VARS IL:READ-BDFCOMS) + :CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME READ-BDF) - :PREVIOUS-DATE "21-Apr-2025 16:03:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;50| + :PREVIOUS-DATE "21-Apr-2025 16:23:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;52| ) @@ -283,35 +280,36 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST :TEST #'EQL))))))))) -(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (IL:* IL:\; "Edited 5-Feb-2025 12:56 by mth") +(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT) (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)) + (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)))) + (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 (CDR (ASSOC (STRING-UPCASE SLANT) - '(("R" . REGULAR) - ("I" . ITALIC) - ("O" . ITALIC)))) + (SETQ SLANT (OR (AND SLANT (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)))) + (SETQ EXPANSION (OR (AND EXPANSION (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\"") @@ -487,14 +485,21 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST X)) Y)))) -(DEFUN READ-BDF (PATH) (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") +(DEFUN READ-BDF (PATH) (IL:* IL:\; "Edited 23-Apr-2025 16:33 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) - (UNLESS (STRING-EQUAL "STARTFONT" (READ FILE-STREAM)) + (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") @@ -702,16 +707,26 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (FIRST (GLYPH-DWIDTH GLYPH)))) GLYPH)) -(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 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 &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING FAMILY SIZE FACE ROTATION DEVICE) @@ -765,10 +780,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 (2496 10330 (BDF-TO-CHARSETINFO 2496 . 10330)) (10332 16202 (BDF-TO-FONTDESCRIPTOR -10332 . 16202)) (16204 19236 (GET-FAMILY-FACE-SIZE-FROM-NAME 16204 . 19236)) (19238 26049 ( -GLYPHS-BY-CHARSET 19238 . 26049)) (26051 27476 (PACKFILENAME.STRING 26051 . 27476)) (27478 33581 ( -READ-BDF 27478 . 33581)) (33583 33906 (READ-DELIMITED-LIST-FROM-STRING 33583 . 33906)) (33908 40279 ( -READ-GLYPH 33908 . 40279)) (40281 40644 (SPLIT-FONT-NAME 40281 . 40644)) (40646 42825 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 40646 . 42825))))) + (IL:FILEMAP (NIL (2341 10175 (BDF-TO-CHARSETINFO 2341 . 10175)) (10177 16047 (BDF-TO-FONTDESCRIPTOR +10177 . 16047)) (16049 19412 (GET-FAMILY-FACE-SIZE-FROM-NAME 16049 . 19412)) (19414 26225 ( +GLYPHS-BY-CHARSET 19414 . 26225)) (26227 27652 (PACKFILENAME.STRING 26227 . 27652)) (27654 34039 ( +READ-BDF 27654 . 34039)) (34041 34364 (READ-DELIMITED-LIST-FROM-STRING 34041 . 34364)) (34366 40737 ( +READ-GLYPH 34366 . 40737)) (40739 41480 (SPLIT-FONT-NAME 40739 . 41480)) (41482 43661 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 41482 . 43661))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 66bd515f17529d045980a8299da8adaa85db722d..b7caaab52f15e1a2654c3f7b4ed03e6afbf35309 100644 GIT binary patch delta 1373 zcmZvcZ%i9y7{Kqn>mORsRH@s*nBA5s(DeeeE0h8qxAsa8u6Lz(9iVetH>zNmBe;<* zSppjUpq>nQ$9Bgg@q>#lF=lYd4ADsN(w#LV}3Pn;$;&HFsh z@A>n-@AE$GN6YB5>uBM56o2>lu6$e&r>2EiTP(r1cckKnQth3=oTw}O3lo!7{`7RU za;`eY4_C)tuD&u>xftbRah_yMO!ANu-APKWuHW_6|4%Wz;_E_j=Ud;8JX*n<`7qvY z8uBS?os)hA&o#HV&W)dFT+|w0e~}@d&(#$*0Locdo@D>y{6Y(@CGn-^1i^T<`O{M~ z)@AdNqFB-;K~@c^Un;%EFlfYDG;8#XBrCGoZ`T4+Y*-gzNs%0%BB}jG9?U59Tp=oR zmv}fyF+l%>;)`eSR?DH$w{00hr>q6DZlJ6V3ZkND!%`Mtjs{ww?z7_{_Sj7z0@Pye zSxaUhlNU>3#-PVzzH}Wo?ASCOjvPRL;7gGRa`1CUREWxMJyhQ(3GCCYKy6B)L+m>b1I|;`1o{$*4P><9=uT-C zW$}6!KidJ0k|bt{LzPG6-so;V7JSibRBH zm0XEjNjFO5S&!4WUu6)?e8#m>R8(3?LcJ~*u#pNqx7T%rsrW5GTpp;^K=QboWKjH) zn$2mdVZ$_VCVgpcz#af=FSXcvB+Ls>sM8>J)g6c5@oK8!)K9MQJ=ACD7<}!LO-im2 zjBdH)1|?U4Tye>plq>!fev#Y{X?J&9sN3T z7-nr4`}5`5@xJlK#t>sa>mi-6ISV8BnjTdwNIrKq?i=K-Yl@mK8?vUVunoEuK^c_tIO|QLyZHIhULlo|zZWyudiO^D}JSASuZ>;A9miIrt0W ICLTQa3ybE21^@s6 delta 1259 zcmZvcO>7%Q6vuaF9mh^WDM<)T0I>?KnmSoEw(Ev`G+|?p<89Wv&h9!T5>N~YZD@p{ z6hs74MAbtNtJGu&-EAcZ5~v``p)#n78dX9dm5K{+s;Zp1K&1A-g#+ciS!g)m!_1rC z`@c7D=FR%rMe_LtQhSah-+#V?B~|UUlWM9zl~Ixhhf?XGOsXlbIfnA`{KA~_(#g5X zskvFDSbcT2ve>7jk_yP@7ZeQWyB~37s$Hqrq!E z$vsEAR;;cw$0Yb|m~ot{I6O-K*Wxk&1CY*03($RLadP=F(J9>{c?f6QZzi@MxxQzOznIGh(W~XH6S*E7b z0|Sr1Uh*ZVym?wP%FIy>-N6&cUBL`Y^bb*A1XC4;F;p-m~Q#r5dUPNjc*S3Mn3XAT`a02yZFJ8?#Qg~ z<^BN~GR{96`K4w1F%72p=|h*v0N+14MI`>-s76lk8>71;?Y^gqC_2{FM|>|XE(bTI zxMdnTx-)APOS-{wYSyrvvW?Gy#<(-~0%@&(J=RCI_c_qt&wqRRtyn9;!_c<+yq0Nz ze}j+n>x4}6Hw$I{Q=vnPjH8>}eF{1oD_M^2>Xw-j?EFJwT9s8XUl31)TUn*UwqU=dI_l_T{m02IA|JnZ?{C<}YPbLZ diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index 50e3c235f0fbbc4c0f6e80621e9144061bb0b8cd..1148b7eef60b3624f113a2a1111bd7bba51dbac6 100644 GIT binary patch delta 1493 zcmZuv&ubGw7@bM0H8oY527e&vS1nc17OX8u!9y?+0=1PU7JA%fXYJx|j6N(nRm5M4(#(r}FY#&Hi?$3JP;F_kQma2*Dz86YS#B8l>Z8WWYOPwI zrN*Z5u@goSCT6Oc(XQS~C_t>tt~GedZSs7-zv;psh0`XQf`4^# z0E)siqfC>Ey$xd#>{ur)Ga=CCn1V3&!}vMEHI;F1m@KXiV;W96JKF1sKS57We*f)g zex$S@geb@ZF=GDZ(6E@2qR^${WVcXU=>8g?-!B(uq!e8}F)d~H&BS-JdZj6|ejHeT zlwNeCQ4k_0hRu2xB>)Cb;p=dxfD!=j4D`q{b^r{a040wCNDjrI%IF{f{&~?cE4UcX z68K<*3*7P{QEq8TLeCB7EDSjGO^?0+JKERQOL`x=fiXaXwr$0Dh%M7 z5FTrWb`2rWq*7S_7F@{E=8GWMY4aFlI;ZRkg>1q=u%@%|@9f%Y14$nAqbR5LGgKh+ zLR8nG5J=*zH6iH7#aJ>HK5vv?f{Sr}grdf#dRv0b>+fI@YPFR-i#kFfmY*UTs6HK( z$3je({yYRv142hm`jMtVdT&Z_FC3$aAB12GxcLO-p#e~G_M(?1lU;or^5|l`e((5Te=xZ`r#Cb*SHtHYOlT_a From edcc0e397bc5a7a1f8ed1c09afb1bca93ca0a750 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Wed, 23 Apr 2025 18:03:14 -0700 Subject: [PATCH 5/7] Account for glyphs with a negative initial offset. --- lispusers/READ-BDF | 27 +++++++++++++++------------ lispusers/READ-BDF.DFASL | Bin 19899 -> 19935 bytes 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 7b10d4139..7bf7b4b3f 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,11 +5,12 @@ 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 "23-Apr-2025 16:34:17" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;53| 45086 +(IL:FILECREATED "23-Apr-2025 17:55:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;54| 45384 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME READ-BDF) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO READ-GLYPH GET-FAMILY-FACE-SIZE-FROM-NAME + SPLIT-FONT-NAME READ-BDF) :PREVIOUS-DATE "21-Apr-2025 16:23:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;52| ) @@ -55,6 +56,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) (DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 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) @@ -155,7 +157,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST GL)) (SETQ GLW (GLYPH-WIDTH GL)) (SETQ XCODE (GLYPH-XCODE GL)) - (BITBLT GLBM 0 0 BMAP (+ DLEFT (GLYPH-BBXOFF0 GL)) + (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) (+ DESCENT (GLYPH-BBYOFF0 GL)) (BITMAPWIDTH GLBM) (BITMAPHEIGHT GLBM) @@ -169,7 +171,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IF SLUG (LET ((GLBM (GLYPH-BITMAP SLUG))) - (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (GLYPH-BBXOFF0 SLUG)) + (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (MAX 0 (GLYPH-BBXOFF0 SLUG))) (+ DESCENT (GLYPH-BBYOFF0 SLUG)) (BITMAPWIDTH GLBM) (BITMAPHEIGHT GLBM) @@ -607,7 +609,8 @@ 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 21-Apr-2025 13:37 by mth") +(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") @@ -702,7 +705,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETF (GLYPH-DESCENT GLYPH) (ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH)))) (SETF (GLYPH-WIDTH GLYPH) - (MAX (+ (GLYPH-BBXOFF0 GLYPH) + (MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH)) (GLYPH-BBW GLYPH)) (FIRST (GLYPH-DWIDTH GLYPH)))) GLYPH)) @@ -780,10 +783,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 (2341 10175 (BDF-TO-CHARSETINFO 2341 . 10175)) (10177 16047 (BDF-TO-FONTDESCRIPTOR -10177 . 16047)) (16049 19412 (GET-FAMILY-FACE-SIZE-FROM-NAME 16049 . 19412)) (19414 26225 ( -GLYPHS-BY-CHARSET 19414 . 26225)) (26227 27652 (PACKFILENAME.STRING 26227 . 27652)) (27654 34039 ( -READ-BDF 27654 . 34039)) (34041 34364 (READ-DELIMITED-LIST-FROM-STRING 34041 . 34364)) (34366 40737 ( -READ-GLYPH 34366 . 40737)) (40739 41480 (SPLIT-FONT-NAME 40739 . 41480)) (41482 43661 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 41482 . 43661))))) + (IL:FILEMAP (NIL (2397 10356 (BDF-TO-CHARSETINFO 2397 . 10356)) (10358 16228 (BDF-TO-FONTDESCRIPTOR +10358 . 16228)) (16230 19593 (GET-FAMILY-FACE-SIZE-FROM-NAME 16230 . 19593)) (19595 26406 ( +GLYPHS-BY-CHARSET 19595 . 26406)) (26408 27833 (PACKFILENAME.STRING 26408 . 27833)) (27835 34220 ( +READ-BDF 27835 . 34220)) (34222 34545 (READ-DELIMITED-LIST-FROM-STRING 34222 . 34545)) (34547 41035 ( +READ-GLYPH 34547 . 41035)) (41037 41778 (SPLIT-FONT-NAME 41037 . 41778)) (41780 43959 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 41780 . 43959))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index b7caaab52f15e1a2654c3f7b4ed03e6afbf35309..fda6acb415b7cf7a27424079cec4b86531a4f848 100644 GIT binary patch delta 330 zcmdlzoALf^#tE^ECKKb7*v+j>O|6VfC${Usm>c)pWreXPFJQA|G}(NM?V||e?#XAQ ziy7TFJIGitG0vP^DQCeGudzSNU*q${tVVy0$s6SYwUYdWHih^Lu`vL_NwIi^tSo;q zFBo4aUJj^S4y;^mvV#0F?F}>4niv?EC(Tp@QB5 zaC5mO2Me>QnbGDZ+caioQ*(pKuN^uVJ2#g&`ZIIK3jtj$1a|S}LoQ*A9GMUkV>c_f H&1MGx#`|G; delta 293 zcmcaVn{oGS#tE^E#uMX|*v+hrO{@&fC${TBnHC%O++~FcPhP-g$!NU!7TZS=#>JD* zNEb8eZ+4KeU}Ef@Tq$QUd9PfcT%NzsCJ%ohHU=O#DHgAgmE|wy1>*}%wvb<@J!7U? z69WTt)l5YYl{HftL?zEu0a4swL8jkeL8dR0ITcd8Ce4`I!ye=s;N$4*3Q|)t6G$>9 zgP8d<^*~hQOfL}S2chgB6e~g*16Uc;tIgXLu1YW)nOSb`x8z`9HnKF>Jj*tX8OX4h f% From beadb985646385b1f8fe032dd6743d52e4db97a7 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Thu, 24 Apr 2025 16:54:10 -0700 Subject: [PATCH 6/7] Add VERBOSE optional parameter to READ-BDF to report font internal FAMILY, FACE, etc. Change &OPTIONAL parameters of WRITE-BDF-TO-DISPLAYFONT-FILES to &KEY to simplify calling. (No need to remember the order.) Add CHAR-SETS and WRITE-UNMAPPED parameters to WRITE-BDF-TO-DISPLAYFONT-FILES to allow some level of control of which DISPLAYFONT files are written. Updated documentation, and added warning note about font's FAMILY containing any digits. --- lispusers/READ-BDF | 78 +++++++++++++++++++++++++++++---------- lispusers/READ-BDF.DFASL | Bin 19935 -> 20850 bytes lispusers/READ-BDF.TEDIT | Bin 6848 -> 9264 bytes 3 files changed, 58 insertions(+), 20 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 7bf7b4b3f..8319cf7f2 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,14 +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 "23-Apr-2025 17:55:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;54| 45384 +(IL:FILECREATED "24-Apr-2025 00:45:54" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;56| 47327 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO READ-GLYPH GET-FAMILY-FACE-SIZE-FROM-NAME - SPLIT-FONT-NAME READ-BDF) + :CHANGES-TO (IL:FUNCTIONS READ-BDF WRITE-BDF-TO-DISPLAYFONT-FILES BDF-TO-CHARSETINFO READ-GLYPH + GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME) - :PREVIOUS-DATE "21-Apr-2025 16:23:52" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;52| + :PREVIOUS-DATE "23-Apr-2025 17:55:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;54| ) @@ -487,7 +487,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST X)) Y)))) -(DEFUN READ-BDF (PATH) (IL:* IL:\; "Edited 23-Apr-2025 16:33 by mth") +(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (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 @@ -602,6 +602,14 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETF (BF-SLUG FONT) GL)))))) (ENDFONT (SETQ FONT-COMPLETE T)))))))) + (WHEN VERBOSE + (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) + SIZE) + (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) + (FORMAT *STANDARD-OUTPUT* + "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" + (BF-NAME FONT) + FAMILY SIZE WEIGHT SLANT EXPANSION))) FONT))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) @@ -731,12 +739,30 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (LIST NIL NAME)))) -(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &OPTIONAL MAP-UNKNOWN-TO-PRIVATE - RAW-UNICODE-MAPPING FAMILY SIZE FACE ROTATION DEVICE) +(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE + (CHAR-SETS T) + WRITE-UNMAPPED MAP-UNKNOWN-TO-PRIVATE + RAW-UNICODE-MAPPING) + (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)) @@ -747,17 +773,29 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (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 (\\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)))) + (IF WRITE-UNMAPPED + (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE + UNMAPPED-FONTDESC CS + (PACKFILENAME.STRING + :BODY DEST-DIR :NAME + (\\FONTFILENAME (FONTPROP + UNMAPPED-FONTDESC + 'IL:FAMILY) + 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 @@ -783,10 +821,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 (2397 10356 (BDF-TO-CHARSETINFO 2397 . 10356)) (10358 16228 (BDF-TO-FONTDESCRIPTOR -10358 . 16228)) (16230 19593 (GET-FAMILY-FACE-SIZE-FROM-NAME 16230 . 19593)) (19595 26406 ( -GLYPHS-BY-CHARSET 19595 . 26406)) (26408 27833 (PACKFILENAME.STRING 26408 . 27833)) (27835 34220 ( -READ-BDF 27835 . 34220)) (34222 34545 (READ-DELIMITED-LIST-FROM-STRING 34222 . 34545)) (34547 41035 ( -READ-GLYPH 34547 . 41035)) (41037 41778 (SPLIT-FONT-NAME 41037 . 41778)) (41780 43959 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 41780 . 43959))))) + (IL:FILEMAP (NIL (2427 10386 (BDF-TO-CHARSETINFO 2427 . 10386)) (10388 16258 (BDF-TO-FONTDESCRIPTOR +10388 . 16258)) (16260 19623 (GET-FAMILY-FACE-SIZE-FROM-NAME 16260 . 19623)) (19625 26436 ( +GLYPHS-BY-CHARSET 19625 . 26436)) (26438 27863 (PACKFILENAME.STRING 26438 . 27863)) (27865 34669 ( +READ-BDF 27865 . 34669)) (34671 34994 (READ-DELIMITED-LIST-FROM-STRING 34671 . 34994)) (34996 41484 ( +READ-GLYPH 34996 . 41484)) (41486 42227 (SPLIT-FONT-NAME 41486 . 42227)) (42229 45902 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 42229 . 45902))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index fda6acb415b7cf7a27424079cec4b86531a4f848..baf185d5368bad564768eeddcf73c2122bc75fc0 100644 GIT binary patch delta 3468 zcmai1eM}qY8Nc^zJ`#-Ul7mo}B-eZ`V;B(vp`pscf$iK8+b^;Wge|Fi4WwtnmlCqA zlNMvTG;Qi;F&A2UX}gR+rfSnP45}0e}{Kq}tzxTQKdEVze-?~ihPLYd8$=>9X72XDyG;-2aUsvBK*3~sPG&VOjtoKSG zpLjev&?g={*{6>7^@?Hb^vP4b>a#UseS-)A(E*W#)QGu|%))OAHhc+`ex-09**p8E z!k@T`UK`@LEr%uje8YhfO};Nw82#|9)ZcBWDRLT7;Hz}f=nC>_OG+mx-I7XJJEX9j z9_Ki6B$X)Y@&sFH$itsb7j~z9kg$1`fZNp}wH=ZUdaT2#i-`gy(9s$0PZ#%rd0m?< z1*NvIC-{^;(pVn5lzN2#lGQoP!B5UQ*D=})%i4_fjJ-H^KCd;V|D5x(q3Ne6VSusX zQ_O-Oyckr4SH?3IHE&{|WyVy-;*+yw7`2XzfpZVR)fAr5^$=!5+^UI;Wt*H`pLbsR z1#lqa(g+2f&#=|*%xsXe#f6Lo7lAV}{Ox=cI0_6h=jfNS0%3{RjXh#AIu_Gr%KPQ4 zeJQEE1Z02*W;{Bk%?PWA_TLm10c0xo?siN76z5i9*Q_rHJlIY=z-9#-U1N)_E+fFZ zXZSs9jB9N+ux)&R&2D7Ke;;6TfbG@;Y-L8qM{cedr!w5{Kes*FBy39m66{C6ra61& z<*fBee7cLZtSoTX+7~`kTm9Eftufws`Li1Z2y&LkdJpipcWnP1M)TUL@z5_B?p{7p z&N@n1IYIZgwfSZ9`BfT8Z7kX|p-flF*-9*>#x&oECEH&BO+VCeEc$v5uhJ}8em`@s zQn}zeaepZ}J=6|w0k)OgDvU)rTY>$Q<;`YcXip{sP;$Ek+D3a77&5qgXH5GMa6AE9 zd~lgHn;p8%4wl#Rs{xe$*gheaYr#o&qzjGAr{KWNDBy)#(?jMJ{s=iruKW3jokSc4 z1=vWL;e)4ObXVkF#ccB|*G`21bJa4dOvF2psqsr)Su^R~K;4CF@;vcRKg{6Qy zCI#It+8KsXP@S4cII24X-8dPBHhD`6$q#TtIzFw=bh|)W=FXyWqyEl;8|1Ej zp{2X_HiUm!QkYZIZp)*X$3GF3e5{vAO^^TI6`N8CB7Wt{Hk;w$e|xV$$H~r`0A49$O=|h8C$aXf0wU zr<-XlVe)2Lhv`Z9g!M5`T31@YHr2)+=6ytK`51sqza5x4OsgSO1Buq<;1pU%n7otL zu7RUFQNS$n$hBWYuHyl2`YnyU%4WJ1K&olYc2WRm_?wS#{P;5b*f-!Hd<5E3i9$H9 zG!RZDirt=2*yUD&tW&vn;e)TxEBO^)56bU>Z1qZQ9-zfA>Lu3O%*XBNQc#OugszY$ z90IkyJE(*`uFim8>ge#eQy29cTPkB<*btPuL9Mh=x5vedO5k8QEXW^9H!r^kerB_hD)>QM$tepUpk45WI!Y!?Zs} zShW}z+U5WiZyx>FICMO}6N0P($+c)tf32_Qjn%HIY8OOA23;&>^;}Tq;tvH&{)0^U$grN)jQwQz)NM)) z5mK>TmBkt5othU52E-ZOu3W2GU0A9{KzAt1g)(JXE#F8}x}-wcZ(QFlghcK@$`DGP zjGKM_pvT=VG_?xNUj1P5RJ_0+Y~K>vlQQ;#yQoPNI)tW>x1(D*R9g~FB;O~)gy^pB zC-5U`rA18kK`N7KV(O{byZKW!{c{dwLf7YLVSqY^F|r^CH^7np{BTCslXo#vt2&a= z1w_q?QAH#Q;4X^U{2Y@;2s0tC^K?e{w5S>L;OVbG0~=E#6(IMpY?Gr)M9pAeDnNLm zX1G7{Q2?|t${esw)NGU$VpgkNiAXFekCqIGnt3`Q9|JMSfifJ4$)o&3M)Ng8Ay6iB zcQ<1JaB$=y?Y#Upo&(?B1$=t&N%MTshiPok@eEfz&pF>`2H(;Jd=@oB|6agn1>emD zd^R-`pjYOcBN=l2vG&MkpeX~>(2oIGc6417HSYYO^j5Z`B2O;0Ogu7M<(Im~C{d3; z+9+TUHG=aV_f^8L(R#Xb?(J2Ra~54FH8z&BSLuYN6RJnoamWtWAq z?Meh;b`O#T=&j)L#dzFD}JWQJ`sgXdg68&L6fwe8u9fxSOYq)+-e zo>x!KUFr;b)vy&07+!Y3yXPJ1K!ZiahFOX7{d#+4At5vcuaq9iKY3H56beag?%JBl zGWLAGgQs1*RS0bHcDe)pPGwE~Z;L1WEQXwD!q7>jV#71GNgj>6MS$0Lcm+?{SoelS zl$wTo~O9ie^%N-NZ*N>gaN2SrEYn0&f9K zHj=~g+w!ms%Ts}PMBqd)1Hxp7<3w&qM9ZchXFbrX{&Cg?zm;IYx40);(AggF8=AcC z+I3aRo10fHzPA#g_e!!?9J{djGunO_KHqFGUwr?f=D@Yel5&L<+Jj)$*BCW3ohzbx zlu)FUjO!XbK903<7!Q{yUp8E(e<}NgZSGqT{`go}O{}E4wYp`cvWlyX<7d*Oc* z)+OWA_1uYWZf7& z4LC-%0q44%j*Hw5dZ~q@6P|=8=I=GCO`{dqc0_v+hV4fU{Jw-Q*4k@Uy$NqD&}&i~ zJYHY3rPrBaBJL6ypLOkSy+GMks8 z&UsuCj|TQ2PwRY=wwwdL^o5{g1%gt^v4R%B_Pt~!q$u|VZc4@tuw+s&l#Cla-p-KQ z`cb(Z9=+>$fykb?<3L~Z~Q*}(NKlB;u2q9K%wWHCc1rXs0MUuwC4#=(tDkdcy9D7zXxg^atHoet6{)Ah+SaeYu| z^D^K+%xIK6UCbC~D6W;MW2gpjZOI6i^6TN0E=|UZJ$`sBLKnL@173dgXdV1p(*cjn SsAQz2l#Jbw&Qe`ucJ^Pv0JKX0 diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index 1148b7eef60b3624f113a2a1111bd7bba51dbac6..9ecae0f3613f3d3531139496195957bf362a5099 100644 GIT binary patch literal 9264 zcmeHM+j8616@_dkt?0CAn@p2lrag5tDLIumk|JNCnRH51kc65d84|RuX4)x4f+A`V zU;)s!@(G##L*Lt(en4OP*2xF-6Y}0qaMs$uIRq`rPA}8RLzsjD_u1#{z1O}T(ZtQQ~-9M=8R4Tib%66qAAaeD^Jx^+hhCWZ z!%5vA&1)5R5~OMr59d=q%2ep3ness-4{pwX?NzvtDu9Zm+XHXu3|P zo$s8+qj~77kv|S1KUL#-G|YlHN>vuC#P>!DnyPV}OuY<$AYmMYe!8K&Xr!`33U=lY>s%&6(5?{9X_R(HU9QS$IC1KtvKx<#!s-lcAprz@c^JL@J`BP|Z_+ zgFNY~W1j?Js3zWH9|}&r*$k$xI6g?!APR=@$X9-ZKcYpfj>QQ-OVz_>vu{@Fs(~{j z|4DeRhA^A(rRUSrI80Rl8;Nm&l$ZE9Dc5}F4Ig=DP`+|7XbZ0WN)?#xX{V}g!#z^( zcDls8(Ng#A-rY{$uC0G`P+6!9?S8+<=*TUOSKoIjK2;kJQHknFBakSZXTH@SDdD(^vvJ|II zXQ9uy+YreHJ8?B)7;#4w#&bx;4?l?zBodBP-$bK&j0}O{g<=QZGziZ(R6qC_JP-Wf zYyyG((2MYgDA`YEUJi(d9P)AQ6j?A@gs6C+$N>q_YBLT)A1U(K=gBWTlU5}GLReI1 z?i@6lc3t)ToaFS5)z0nu_RfYnz$%goc?KI3@F!3w9VWqypww%5NImE|uFcZ1>2@|t z>9%>`wCuiG#|o2g-|o9u?x}b0*(Z>B?6gi)-}$vI@>Q?nHW-WGyYDn@)jVqSHv6{Q zSI3R+=AeDA-FeWagl^Bd-*9b}iygGF+_m>rukip}PP4ObZ<6G+4{Ph|&xi9%bd{2k zuBaJO9STDThwlw1d9Ds8Ug8bmBbEA@dNK*HP{drSYfDiM5F#-GtIl8|BGWml;;GNL zxHPouNP#?NQzc;serk!7VaUbe#bKNzemaXIDJSXtbaRB18)k8G&chAz$jxPSqxtmI zPmDqgKEtfFn#py zk^rpenfC~OHdYlfDXLypzzfq@w1~7oc(K`Yx^AZjjnB~S)TIhZ7a39?I;v1#hZ;H_ z3g;LF(yaKr*-I}{kZkYB}FdvS=LiEiJ$0VQeB+JF(R!MfHGbR z1WV2kgw!b_c@#_MMJ>WItd&WlKpGJ|LFk3Za(2e$c9>0K1c#1@axJ58&`Ta;Fj0vY zok=MpacPP{w0Of(H+-o#ndgf#CmLM>53nQHRmv>zga`2}l7M=yMLgH&&y7t*{A_@b zO}HIX8nRwhi&3p+CNiclu=5mJFud=FQuSG5FN~RT)(!Neyg}VioCzZoQe6{^Y{p4a zIA{YWA0?wtWko*|n~ZNzhLQw@IiJMn7A6N&c`iN{<%1@Pgo}1jrzNK$50KQqXNM}9 zBK5myr8k5-^%P4MBgBlitb<(12Qo?0Vt~SQ|5TP<1V!$Y8^q%VGY4KQTrGVB{;$iV z`jYOUhsZHzBwfp@97PxTURtWq%e zEapu;KjTul^XLmmrWThl{(EX@Q`iCb4qGSPBZPmNdC?G2r$-%DYT}5D&2_^lncoI* zA>=fg*NLhcDYnX|mqNx8uZ9P4}hjmu?;6BvG({q%d4`fX| zhk{iIWLb=S8G2BL80%Ukq zNqsNDfQ^|HA(*PFUq7p(Binejz}6ii*5+qY!qIiTh(W0@&L!LCg3Z!wRxd%PFRr*L z;q8S~Y=UeiV?7bm8m7jJJuZV8KpBrQIl%<6k8>$J$1gTl`Bk!2rZCnT=vazX+@9dP&Ehl-PSH_9JRn~&O5$AtG9kfKfq_p#JAd;~gcZO> zQ-j-1;yIG@oKsSM>O`18yBSTP`|8G%pL!UFaDqoV69+ zRiKb~EN;+>#RwBHTLcOmHc$O2?o^n)A!f!%J}G8V~bw58;qnyOa2jl+BaPhGnw*N>Ku3ss^HIxVN;v=2I} z+UPazI!$%s2L7$7zT4=zxJz^IPt`V#;c>UNchv3ocX+7m%%`v}wzfK*dwo^?aM0LS zO}p*dJ$t_o-txnfAzaH4m z;gPG3?R{r(OvUV;mOSX&JpqS^_T3YxiznOxJH2DPw73WxfZ4vitKPe%cJAE4pIXje zJwl@Zm^oa<5BG#h4BBlhkc7Q=cGd0OU3GJ(yw|lKy0TH+3YPb8sok5m)UBN81>>4qB65?pv}x_rmu}kqf}2WmtlRkUnGpnYu2`Qz@G4p5 zZGr-}eH+AUSFgStg>CB->yx!Ra>g~HP(E$dv)=IP7nSfUo&uHRBRDV2xXzp`io12a zRM~Ux72nsa*R40LSM!c$<-ObjDsNb?95(O@O_Q+o0^2Iuw^s07SwRD!zq5K(v^mF> z|E1DwHTr$D3 zf;g@St|Tm3ij}nnnRtjCL>7aXAX`2~vO^QdPk?2k5P7z+aEVrkJB&nmpd#0~B;pF~ zq~MW2RYk@7d>}>aCHYNFk&Qf}rYTy~+7C2E)Zy0;HHAQs@D2&wz?v-D3NI-?(G&rI zU!pNB`YxB2C}Q~%j!1E_==Pqrr)_qNpR$dWT!;m#$;fkhM zhF1WjHh;x`OS>fqxZ5~HOEgHBkklAo;YsEcN)#Lg7T`}0z_csE@wR4_9O6a;-YXVeRn;g%5TqgH|f3E!<8> z^Yq>A>lSTfzfs0prZ;XidF@}($*IAEX0N2D8Qcbn_MpKFySVs(-kU^3)-*M-=^NYhNU|^#F zGgyki$%IMZI{h_nbXfo^x+O>f3E+w#+!ezt3j)8eVH(^|3peltm2F-G0;z324Fq#D z2Tx@|LL@+}oRdG^={T4f0)w8JZ6yC7X9ck%#Dc&*tLlQFG#BIPP>1h~^1Ks_XA7qH zp+Vyud$5CiGNjb$wteKZ0jTJ;i3I)Z%B)NF1kN?#l#l>nPe!$=EXm%-B0}PS z9?M41Yx>*>*?5hAn!q)tRv9gDPNDFfiZlQ4*yL2>XBf1?8wy!?;diqPLLSMaj`tdi7mr<+$ From b3796eb9d2bca5101b8d76b2e111f6a9591b185c Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Fri, 25 Apr 2025 10:13:11 -0700 Subject: [PATCH 7/7] Missed one edit in previous commit. Swapping the order of 2 parameters in WRITE-BDF-TO-DISPLAYFONT-FILES. (Since they are &KEY parameters, it doesn't matter functionally, but match the documentation.) --- lispusers/READ-BDF | 11 ++++++----- lispusers/READ-BDF.DFASL | Bin 20850 -> 20849 bytes 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 8319cf7f2..9173001df 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -5,11 +5,11 @@ 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 "24-Apr-2025 00:45:54" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;56| 47327 +(IL:FILECREATED "25-Apr-2025 10:10:08" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;57| 47436 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS READ-BDF WRITE-BDF-TO-DISPLAYFONT-FILES BDF-TO-CHARSETINFO READ-GLYPH + :CHANGES-TO (IL:FUNCTIONS WRITE-BDF-TO-DISPLAYFONT-FILES READ-BDF BDF-TO-CHARSETINFO READ-GLYPH GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME) :PREVIOUS-DATE "23-Apr-2025 17:55:25" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;54| @@ -741,8 +741,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE (CHAR-SETS T) - WRITE-UNMAPPED MAP-UNKNOWN-TO-PRIVATE + MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED RAW-UNICODE-MAPPING) + (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") @@ -825,6 +826,6 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST 10388 . 16258)) (16260 19623 (GET-FAMILY-FACE-SIZE-FROM-NAME 16260 . 19623)) (19625 26436 ( GLYPHS-BY-CHARSET 19625 . 26436)) (26438 27863 (PACKFILENAME.STRING 26438 . 27863)) (27865 34669 ( READ-BDF 27865 . 34669)) (34671 34994 (READ-DELIMITED-LIST-FROM-STRING 34671 . 34994)) (34996 41484 ( -READ-GLYPH 34996 . 41484)) (41486 42227 (SPLIT-FONT-NAME 41486 . 42227)) (42229 45902 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 42229 . 45902))))) +READ-GLYPH 34996 . 41484)) (41486 42227 (SPLIT-FONT-NAME 41486 . 42227)) (42229 46011 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 42229 . 46011))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index baf185d5368bad564768eeddcf73c2122bc75fc0..631844166fd9d07c74def7e4f73c1263b6b29804 100644 GIT binary patch delta 291 zcmeygi1Fhh#tE^E<`d(@TupTy3yO4&42(<_3=OP+$iRZj%`w~Gkx-V-)5fcV7VZWz{SaRe#MOUH-GYLU;+Rv(pVG# delta 294 zcmeyki1E`R#tE^EW)tJY+)Q*G3yO4&42(<_3=FJHOsz~!xZE6reH79%b5a$Oi&7Iy zQd1N{GD?ezQxYq66pTz1fEqG$6hK;Z6rfr*?!3qzqvfe3SQh&t~+S9O-jakS{#QGsIOl)XAi&jS z#)Qd?`jV3)eBA;*%`|UfU|@VZ6GUDC5ie#+fv5vukpvKP?Tr2&9#6jz*Pvim=MYbS sKak)ekUUcWh?xsk`W3{?nEcMSndb&rE(j!WX>zS!G2?^HAN?Ab0J@b~tN;K2