Fixed incomplete description in documentation.
Changed parameters for BUILD-COMPOSITE to simplify, and enable keyword :VERBOSE parameter. Added some VERBOSE progress messages.
This commit is contained in:
Matt Heffron
parent
5a0a9dfd6f
commit
b5ccfdc4e7
@ -4,16 +4,13 @@
|
||||
"FONTDESCRIPTOR" "FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC"
|
||||
"UTOMCODE?" "MEDLEYFONT.FILENAME" "MEDLEYFONT.WRITE.FONT")) READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED "30-Nov-2025 17:43:25" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;75| 50310
|
||||
(IL:FILECREATED " 1-Dec-2025 23:07:52" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;3| 50528
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (IL:FUNCTIONS GLYPHS-BY-CHARSET BDF-TO-FONTDESCRIPTOR
|
||||
WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE BUILD-COMPOSITE READ-BDF
|
||||
BDF-TO-CHARSETINFO COUNT-MCHARS)
|
||||
(IL:VARS IL:READ-BDFCOMS)
|
||||
:CHANGES-TO (IL:FUNCTIONS BUILD-COMPOSITE READ-BDF)
|
||||
|
||||
:PREVIOUS-DATE "30-Nov-2025 16:05:42" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;74|
|
||||
:PREVIOUS-DATE "30-Nov-2025 17:43:25" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;1|
|
||||
)
|
||||
|
||||
|
||||
@ -305,65 +302,72 @@
|
||||
(LIST CSET)))))
|
||||
(LIST FONTDESC CHARSETS))))
|
||||
|
||||
(DEFUN BUILD-COMPOSITE (BASE-FONT &REST FILL-FROM) (IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth")
|
||||
(DEFUN BUILD-COMPOSITE (FONTS &KEY VERBOSE) (IL:* IL:\; "Edited 1-Dec-2025 23:07 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 12:32 by mth")
|
||||
(IL:* IL:\; "Edited 26-Nov-2025 21:23 by mth")
|
||||
(IL:* IL:\; "Edited 18-Nov-2025 21:22 by mth")
|
||||
(IL:* IL:\; "Edited 16-Nov-2025 18:25 by mth")
|
||||
(IL:* IL:\; "Edited 14-Nov-2025 17:04 by mth")
|
||||
(LET (MCHAR-PRESENT FONT)
|
||||
(UNLESS (AND FILL-FROM (LISTP FILL-FROM))
|
||||
(ERROR "FILL-FROM is not a list."))
|
||||
(WHEN (LISTP BASE-FONT)
|
||||
(LET* ((BASE-FONT (FIRST (SETQ FONTS (IL:MKLIST FONTS))))
|
||||
(FILL-FROM (REST FONTS))
|
||||
MCHAR-PRESENT CHAR-COUNT FONT)
|
||||
(COND
|
||||
((OR (STRINGP BASE-FONT)
|
||||
(PATHNAMEP BASE-FONT))
|
||||
(UNLESS (IL:INFILEP BASE-FONT)
|
||||
(ERROR "Initial font file ~S doesn't exist or is unreadable." (NAMESTRING BASE-FONT)
|
||||
))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Loading initial font file: ~A~%" (NAMESTRING BASE-FONT)
|
||||
))
|
||||
(SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T :VERBOSE VERBOSE)))
|
||||
((NOT (BDF-FONT-P BASE-FONT))
|
||||
(ERROR "Initial font (~S) is not a BDF-FONT, nor string, nor pathname." BASE-FONT)))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Initial font contains ~D MCCS characters.~%"
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))))
|
||||
(SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT))
|
||||
(LOOP :FOR FILL-FONT :IN FILL-FROM :WITH PREV-CC :WHEN FILL-FONT :DO
|
||||
(COND
|
||||
((OR (STRINGP FILL-FONT)
|
||||
(PATHNAMEP FILL-FONT))
|
||||
(UNLESS (IL:INFILEP FILL-FONT)
|
||||
(ERROR "Subsequent font ~S doesn't exist or is unreadable." (NAMESTRING
|
||||
FILL-FONT)))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Loading subsequent font file: ~A~%" (NAMESTRING
|
||||
FILL-FONT)))
|
||||
(SETQ FILL-FONT (READ-BDF FILL-FONT :MCCS-ONLY T :VERBOSE VERBOSE)))
|
||||
((NOT (BDF-FONT-P FILL-FONT))
|
||||
(ERROR "Subsequent font (~S) is not a BDF-FONT, nor string, nor pathname."
|
||||
FILL-FONT)))
|
||||
(SETQ PREV-CC CHAR-COUNT)
|
||||
(LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT)
|
||||
:WITH V :DO (SETQ V (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP V)
|
||||
(EQ (FIRST V)
|
||||
-1))
|
||||
(SETQ V (OR (SECOND V)
|
||||
-1)))
|
||||
|
||||
(IL:* IL:|;;| "Allow specifying both BASE-FONT and FILL-FROM in a single LIST.")
|
||||
|
||||
(SETQ FONT (FIRST BASE-FONT))
|
||||
(SETQ FILL-FROM (APPEND (REST BASE-FONT)
|
||||
FILL-FROM))
|
||||
(SETQ BASE-FONT FONT))
|
||||
(COND
|
||||
((OR (STRINGP BASE-FONT)
|
||||
(PATHNAMEP BASE-FONT))
|
||||
(UNLESS (IL:INFILEP BASE-FONT)
|
||||
(ERROR "BASE-FONT ~S doesn't exist or is unreadable." BASE-FONT))
|
||||
(SETQ BASE-FONT (READ-BDF BASE-FONT :MCCS-ONLY T)))
|
||||
((NOT (TYPEP BASE-FONT 'BDF-FONT))
|
||||
(ERROR "BASE-FONT is not a BDF-FONT, nor string, nor pathname.")))
|
||||
(SETQ MCHAR-PRESENT (BF-MCHAR-PRESENT BASE-FONT))
|
||||
(LOOP :FOR FILL-FONT :IN FILL-FROM :WHEN FILL-FONT :DO (COND
|
||||
((OR (STRINGP FILL-FONT)
|
||||
(PATHNAMEP FILL-FONT))
|
||||
(UNLESS (IL:INFILEP FILL-FONT)
|
||||
(ERROR
|
||||
"Element of FILL-FROM (~S) doesn't exist or is unreadable."
|
||||
FILL-FONT))
|
||||
(SETQ FILL-FONT
|
||||
(READ-BDF FILL-FONT
|
||||
:MCCS-ONLY T)))
|
||||
((NOT (BDF-FONT-P FILL-FONT))
|
||||
(ERROR
|
||||
"Element of FILL-FROM (~S) is not a BDF-FONT, nor string, nor pathname."
|
||||
FILL-FONT)))
|
||||
(LOOP :FOR GL :IN (BF-GLYPHS FILL-FONT)
|
||||
:WITH V :DO (SETQ V (GLYPH-ENCODING GL))
|
||||
(WHEN (AND (LISTP V)
|
||||
(EQ (FIRST V)
|
||||
-1))
|
||||
(SETQ V (OR (SECOND V)
|
||||
-1)))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
(IL:* IL:|;;|
|
||||
"Need to change this use of UTOMCODE? based on the CHARSET¬REGISTRY of the XLFD of FILL-FONT")
|
||||
|
||||
(WHEN (AND (UTOMCODE? V)
|
||||
(ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V)))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT V 1)
|
||||
(WHEN (AND (UTOMCODE? V)
|
||||
(ZEROP (CHAR-PRESENT-BIT MCHAR-PRESENT V)))
|
||||
(CHAR-PRESENT-BIT MCHAR-PRESENT V 1)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
(IL:* IL:|;;|
|
||||
"What other bookkeping of BASE-FONT needs to be done when adding a glyph? Any?")
|
||||
|
||||
(PUSH GL (BF-GLYPHS BASE-FONT)))))
|
||||
BASE-FONT))
|
||||
(PUSH GL (BF-GLYPHS BASE-FONT))))
|
||||
(SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
(WHEN VERBOSE
|
||||
(FORMAT *STANDARD-OUTPUT* "~&Font ~A supplied ~D additional MCCS characters.~%"
|
||||
(NAMESTRING FILL-FONT)
|
||||
(- (SETQ CHAR-COUNT (COUNT-MCHARS BASE-FONT))
|
||||
PREV-CC))))
|
||||
BASE-FONT))
|
||||
|
||||
(DEFUN CHAR-PRESENT-BIT (BM MCODE &OPTIONAL (NEWBIT -1 SBIT)
|
||||
&AUX CS CC) (IL:* IL:\; "Edited 26-Nov-2025 09:29 by mth")
|
||||
@ -461,6 +465,7 @@
|
||||
Y))))
|
||||
|
||||
(DEFUN READ-BDF (PATH &KEY VERBOSE MCCS-ONLY (EXTERNAL-FORMAT :ISO8859/1))
|
||||
(IL:* IL:\; "Edited 1-Dec-2025 22:40 by mth")
|
||||
(IL:* IL:\; "Edited 30-Nov-2025 11:59 by mth")
|
||||
(IL:* IL:\; "Edited 28-Nov-2025 17:39 by mth")
|
||||
(IL:* IL:\; "Edited 26-Nov-2025 22:47 by mth")
|
||||
@ -877,11 +882,11 @@
|
||||
|
||||
(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO)
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (3235 10173 (BDF-TO-CHARSETINFO 3235 . 10173)) (10175 16397 (BDF-TO-FONTDESCRIPTOR
|
||||
10175 . 16397)) (16399 20017 (BUILD-COMPOSITE 16399 . 20017)) (20019 20768 (CHAR-PRESENT-BIT 20019 .
|
||||
20768)) (20770 21054 (COUNT-MCHARS 20770 . 21054)) (21056 24091 (GLYPHS-BY-CHARSET 21056 . 24091)) (
|
||||
24093 25518 (PACKFILENAME.STRING 24093 . 25518)) (25520 34886 (READ-BDF 25520 . 34886)) (34888 35211 (
|
||||
READ-DELIMITED-LIST-FROM-STRING 34888 . 35211)) (35213 42211 (READ-GLYPH 35213 . 42211)) (42213 43494
|
||||
(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42213 . 43494)) (43496 45913 (XLFD-SPLIT-FONT-NAME 43496 . 45913)
|
||||
) (45915 48927 (XLFD-TO-FACE 45915 . 48927)))))
|
||||
(IL:FILEMAP (NIL (3029 9967 (BDF-TO-CHARSETINFO 3029 . 9967)) (9969 16191 (BDF-TO-FONTDESCRIPTOR 9969
|
||||
. 16191)) (16193 20126 (BUILD-COMPOSITE 16193 . 20126)) (20128 20877 (CHAR-PRESENT-BIT 20128 . 20877)
|
||||
) (20879 21163 (COUNT-MCHARS 20879 . 21163)) (21165 24200 (GLYPHS-BY-CHARSET 21165 . 24200)) (24202
|
||||
25627 (PACKFILENAME.STRING 24202 . 25627)) (25629 35104 (READ-BDF 25629 . 35104)) (35106 35429 (
|
||||
READ-DELIMITED-LIST-FROM-STRING 35106 . 35429)) (35431 42429 (READ-GLYPH 35431 . 42429)) (42431 43712
|
||||
(WRITE-BDF-TO-MEDLEYDISPLAYFONT-FILE 42431 . 43712)) (43714 46131 (XLFD-SPLIT-FONT-NAME 43714 . 46131)
|
||||
) (46133 49145 (XLFD-TO-FACE 46133 . 49145)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user