Rmk103 font and related code updates (#2216)
This PR contains a large number of changes in support of the implementation of the Medley Dsplay Fon file format. The changes are documented in the docs/internal/FONTCHANGES.TEDIT file.
This commit is contained in:
rmkaplan
GitHub
352
internal/FONT-DEBUG
Normal file
352
internal/FONT-DEBUG
Normal file
@@ -0,0 +1,352 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2025 16:43:34" {WMEDLEY}<internal>FONT-DEBUG.;46 19345
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CSBMSIZE FONTSIZE CSSIZE EQCHARBM)
|
||||
(VARS FONT-DEBUGCOMS)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2025 12:36:48" {WMEDLEY}<internal>FONT-DEBUG.;41)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONT-DEBUGCOMS)
|
||||
|
||||
(RPAQQ FONT-DEBUGCOMS (
|
||||
(* ;; "Little tools to help in debugging display fonts")
|
||||
|
||||
(FNS DEBUGCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM EQCHARBM CHARSETCHARS
|
||||
CHARBMDIFFS SHOWCSCHAR CSCOMPARE SHOWBMS SHOWCHARBITMAPS CANDS)
|
||||
(FNS FONTSIZE CSSIZE CSBMSIZE)))
|
||||
|
||||
|
||||
|
||||
(* ;; "Little tools to help in debugging display fonts")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(DEBUGCHARSET
|
||||
[LAMBDA (FONTSPEC CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 9-Jul-2025 16:26 by rmk")
|
||||
(* ; "Edited 6-Jul-2025 22:33 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 16:50 by rmk")
|
||||
(* ; "Edited 30-Jun-2025 09:27 by rmk")
|
||||
(* ; "Edited 25-Jun-2025 19:25 by rmk")
|
||||
(* ; "Edited 20-Jun-2025 16:37 by rmk")
|
||||
|
||||
(* ;; "Reads the CHARSETINFO for FONTSPEC and CHARSET, where FONTSPEC can be a (family size...) specification or the name of a fontfile (ac, strike, medleyfont format). Avoids the MEDLEYFONT files if NOTMEDLEYFONT.")
|
||||
|
||||
(if (type? CHARSETINFO FONTSPEC)
|
||||
then FONTSPEC
|
||||
elseif (type? FONTDESCRIPTOR FONTSPEC)
|
||||
then (\XGETCHARSETINFO FONTSPEC (OR CHARSET 0))
|
||||
else (RESETLST
|
||||
(CL:UNLESS INCLUDEMEDLEYFONT
|
||||
(RESETSAVE DISPLAYFONTEXTENSIONS (REMOVE 'MEDLEYDISPLAYFONT DISPLAYFONTEXTENSIONS)
|
||||
))
|
||||
[if (OR (LITATOM FONTSPEC)
|
||||
(STRINGP FONTSPEC))
|
||||
then (CL:UNLESS CHARSET (SETQ CHARSET 0))
|
||||
(LET (STRM)
|
||||
[RESETSAVE (SETQ STRM (OPENSTREAM FONTSPEC 'INPUT))
|
||||
`(PROGN (CLOSEF? OLDVALUE]
|
||||
(for FNS CSINFO (FI _ (\FONTINFOFROMFILENAME FONTSPEC 'DISPLAY))
|
||||
in DISPLAYCHARSETFNS
|
||||
do (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
|
||||
STRM)))
|
||||
(SETQ CSINFO (APPLY* (CADDR FNS)
|
||||
STRM
|
||||
(CAR FI)
|
||||
(CADR FI)
|
||||
(CADDR FI)
|
||||
(CADDDR FI)
|
||||
(CAR (CDDDDR FI))
|
||||
CHARSET))
|
||||
(PUTMULTI (fetch (CHARSETINFO CSINFOPROPS) of CSINFO)
|
||||
'FILE
|
||||
(PSEUDOFILENAME FONTSPEC))
|
||||
(RETURN CSINFO))
|
||||
(CLOSEF? STRM)))
|
||||
else (LET ((CS CHARSET))
|
||||
(CL:MULTIPLE-VALUE-BIND (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
|
||||
(\FONT.CHECKARGS FONTSPEC)
|
||||
(CL:WHEN CS (SETQ CHARSET CS))
|
||||
(\READCHARSET FAMILY SIZE FACE ROTATION 'DISPLAY CHARSET])])
|
||||
|
||||
(IBM
|
||||
[LAMBDA (FONT CHARSET) (* ; "Edited 29-Jun-2025 17:05 by rmk")
|
||||
(* ; "Edited 20-Jun-2025 16:35 by rmk")
|
||||
(* ; "Edited 18-Jun-2025 14:09 by rmk")
|
||||
|
||||
(* ;; "Inspects the character set bitmap for CHARSET in FONT, which may also be a charset info. If necessary, builds the font (unlike ICS).")
|
||||
|
||||
(SHOWCSBITMAP (if (type? CHARSETINFO FONT)
|
||||
then FONT
|
||||
else (\XGETCHARSETINFO (SETQ FONT (FONTCREATE FONT))
|
||||
(OR CHARSET 0])
|
||||
|
||||
(ICS
|
||||
[LAMBDA (FONT CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 7-Jul-2025 23:12 by rmk")
|
||||
(* ; "Edited 6-Jul-2025 22:04 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 16:11 by rmk")
|
||||
(* ; "Edited 29-Jun-2025 17:07 by rmk")
|
||||
(* ; "Edited 21-Jun-2025 22:00 by rmk")
|
||||
(* ; "Edited 20-Jun-2025 17:10 by rmk")
|
||||
(* ; "Edited 18-Jun-2025 14:23 by rmk")
|
||||
|
||||
(* ;; "Inspects the charset bitmap for CHARSET in FONT. If FONT is a filename, gets the csinfo directly from the file, doesn't build the font.")
|
||||
|
||||
(LET ((CSINFO (DEBUGCHARSET FONT CHARSET INCLUDEMEDLEYFONT)))
|
||||
(if CSINFO
|
||||
then (INSPECT CSINFO)
|
||||
(SHOWCSBITMAP CSINFO)
|
||||
(LIST (GETMULTI (fetch (CHARSETINFO CSINFOPROPS) of CSINFO)
|
||||
'FILE)
|
||||
CSINFO)
|
||||
else "NO CSINFO"])
|
||||
|
||||
(SHOWCACHE
|
||||
[LAMBDA NIL (* ; "Edited 29-Jun-2025 17:19 by rmk")
|
||||
(* ; "Edited 18-Jun-2025 22:50 by rmk")
|
||||
|
||||
(* ;; "Keyboard shortcut to show the current caches")
|
||||
|
||||
(DV \FONTSINCORE)
|
||||
(DV \FONTEXISTS?-CACHE])
|
||||
|
||||
(SHOWCSBITMAP
|
||||
[LAMBDA (CSINFO) (* ; "Edited 29-Jun-2025 17:07 by rmk")
|
||||
(* ; "Edited 20-Jun-2025 16:38 by rmk")
|
||||
|
||||
(* ;; "Given a charsetinfo, shows the whole bitmap using EDITBM. Unfortunately, that runs in a separate process, so we can't directly get the window to put something useful in the title. If EDITBM is called directly, it doen't return until you quit...in which case it's gone. We'd really like just the displayer.")
|
||||
|
||||
(* ;; "If we call the inspector, it asks for contents vs. fields, also a pain, and we still don't get the window.")
|
||||
|
||||
(LET (BM)
|
||||
(if (NOT CSINFO)
|
||||
then (PRINTOUT T "NO CSINFO" T)
|
||||
elseif (AND (IGREATERP (BITMAPWIDTH (SETQ BM (fetch CHARSETBITMAP of CSINFO)))
|
||||
0)
|
||||
(IGREATERP (BITMAPHEIGHT BM)
|
||||
0))
|
||||
then (EVAL.AS.PROCESS (LIST 'EDITBM BM))
|
||||
else "EMPTY BITMAP")
|
||||
CSINFO])
|
||||
|
||||
(EQCSBM
|
||||
[LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 6-Jul-2025 22:04 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 16:12 by rmk")
|
||||
(* ; "Edited 29-Jun-2025 17:52 by rmk")
|
||||
(* ; "Edited 21-Jun-2025 21:20 by rmk")
|
||||
|
||||
(* ;; "True if the two charsetinfos are equivalent in all respects. If either of CS1 or CS2 is a fontdescriptor (not a charsetinfo), then coerces to CHARSET in that font.")
|
||||
|
||||
(SETQ CS1 (DEBUGCHARSET CS1 CHARSET INCLUDEMEDLEYFONT))
|
||||
(SETQ CS2 (DEBUGCHARSET CS2 CHARSETINCLUDEMEDLEYFONT))
|
||||
(EQUALALL (fetch (CHARSETINFO CHARSETBITMAP) of CS1)
|
||||
(fetch (CHARSETINFO CHARSETBITMAP) of CS2])
|
||||
|
||||
(EQCHARBM
|
||||
[LAMBDA (CHAR1 CHAR2 CS1 CS2 EXCLUDEMEDLEYFONT) (* ; "Edited 19-Jul-2025 12:46 by rmk")
|
||||
|
||||
(* ;;
|
||||
"True if the character bitmap for CHAR1 in CS1 is equivalent to the bitmap for CHAR2 in CS2. ")
|
||||
|
||||
(CL:UNLESS (CHARCODEP CHAR1)
|
||||
(SETQ CHAR1 (CHARCODE.DECODE CHAR1)))
|
||||
(CL:UNLESS (CHARCODEP CHAR2)
|
||||
(SETQ CHAR2 (CHARCODE.DECODE CHAR2)))
|
||||
(SETQ CS1 (DEBUGCHARSET CS1 (\CHARSET CHAR1)
|
||||
(NOT EXCLUDEMEDLEYFONT)))
|
||||
(SETQ CS2 (DEBUGCHARSET CS2 (\CHARSET CHAR2)
|
||||
(NOT EXCLUDEMEDLEYFONT)))
|
||||
(EQUALALL (\GETCHARBITMAP.CSINFO (\CHAR8CODE CHAR1)
|
||||
CS1)
|
||||
(\GETCHARBITMAP.CSINFO (\CHAR8CODE CHAR2)
|
||||
CS2])
|
||||
|
||||
(CHARSETCHARS
|
||||
[LAMBDA (CSINFO CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 6-Jul-2025 22:04 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 16:12 by rmk")
|
||||
(* ; "Edited 29-Jun-2025 17:52 by rmk")
|
||||
|
||||
(* ;; "Returns a list of character codes that are instantiated in CSINFO (which may be specified as a font/charset combination).")
|
||||
|
||||
(SETQ CSINFO (DEBUGCHARSET CSINFO CHARSET INCLUDEMEDLEYFONT))
|
||||
(for CODE from 0 to \MAXTHINCHAR unless (SLUGCHARP.DISPLAY CODE CSINFO) collect CODE])
|
||||
|
||||
(CHARBMDIFFS
|
||||
[LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 6-Jul-2025 22:04 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 16:12 by rmk")
|
||||
(* ; "Edited 29-Jun-2025 17:51 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Returns the codes whose bitmaps in CS1 and CS2 differ in some way. Use EDITCHAR to view them.")
|
||||
|
||||
(SETQ CS1 (DEBUGCHARSET CS1 CHARSET INCLUDEMEDLEYFONT))
|
||||
(SETQ CS2 (DEBUGCHARSET CS2 CHARSET INCLUDEMEDLEYFONT))
|
||||
(for CODE in (INTERSECTION (CHARSETCHARS CS1)
|
||||
(CHARSETCHARS CS2)) unless (EQUALALL (\GETCHARBITMAP.CSINFO CODE CS1)
|
||||
(\GETCHARBITMAP.CSINFO CODE CS2))
|
||||
collect CODE])
|
||||
|
||||
(SHOWCSCHAR
|
||||
[LAMBDA (CODE CSINFO CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 6-Jul-2025 22:04 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 16:12 by rmk")
|
||||
(* ; "Edited 29-Jun-2025 18:01 by rmk")
|
||||
(EDITBM (\GETCHARBITMAP.CSINFO CODE (DEBUGCHARSET CSINFO CHARSET INCLUDEMEDLEYFONT])
|
||||
|
||||
(CSCOMPARE
|
||||
[LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 6-Jul-2025 22:04 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 16:13 by rmk")
|
||||
(* ; "Edited 30-Jun-2025 14:02 by rmk")
|
||||
(CL:UNLESS CS2
|
||||
(CL:WHEN (OR (LITATOM CS1)
|
||||
(STRINGP CS1))
|
||||
(SETQ CS2 (\FONTINFOFROMFILENAME CS1 'DISPLAY))
|
||||
[if CHARSET
|
||||
then (CL:UNLESS (EQ CHARSET (CAR (LAST CS2)))
|
||||
(ERROR "MISMATCHING CHARSETS"))
|
||||
else (SETQ CHARSET (CAR (LAST CS2]))
|
||||
(SETQ CS1 (OR (DEBUGCHARSET CS1 CHARSET INCLUDEMEDLEYFONT)
|
||||
(ERROR CS1 "not found")))
|
||||
(SETQ CS2 (OR (DEBUGCHARSET CS2 CHARSET INCLUDEMEDLEYFONT)
|
||||
(ERROR CS2 "not found")))
|
||||
(LET ((CS1CHARS (CHARSETCHARS CS1))
|
||||
(CS2CHARS (CHARSETCHARS CS2))
|
||||
(ASCENT1 (fetch (CHARSETINFO CHARSETASCENT) of CS1))
|
||||
(ASCENT2 (fetch (CHARSETINFO CHARSETASCENT) of CS2))
|
||||
(DESCENT1 (fetch (CHARSETINFO CHARSETDESCENT) of CS1))
|
||||
(DESCENT2 (fetch (CHARSETINFO CHARSETDESCENT) of CS2))
|
||||
DIFF)
|
||||
(if (EQ ASCENT1 ASCENT2)
|
||||
then (PRINTOUT T "Same ascent = " .I2 ASCENT1 T)
|
||||
else (PRINTOUT T " Ascent1 = " .I2 ASCENT1 " Ascent2 = " .I2 ASCENT2 T))
|
||||
(if (EQ DESCENT1 DESCENT2)
|
||||
then (PRINTOUT T "Same descent = " .I2 DESCENT1 T)
|
||||
else (PRINTOUT T "Descent1 = " .I2 DESCENT1 " Descent2 = " .I2 DESCENT2 T))
|
||||
(PRINTOUT T "Common chars:" 14 .PPV (SORT (INTERSECTION CS1CHARS CS2CHARS))
|
||||
T)
|
||||
(SETQ DIFF (SORT (CHARBMDIFFS CS1 CS2)))
|
||||
(if (NULL DIFF)
|
||||
then (PRINTOUT T 5 "All common chars have the SAME bitmaps" T)
|
||||
elseif (EQUAL DIFF (SORT (INTERSECTION CS1CHARS CS2CHARS)))
|
||||
then (PRINTOUT T 5 "All common chars have DIFFERENT bitmaps" T)
|
||||
else (PRINTOUT T 5 "Common chars with different bitmaps: " .PPV DIFF T))
|
||||
(CL:WHEN (SETQ DIFF (LDIFFERENCE CS1CHARS CS2CHARS))
|
||||
(PRINTOUT T "1 but not 2:" 14 .PPV (SORT (LDIFFERENCE CS1CHARS CS2CHARS))
|
||||
T))
|
||||
(CL:WHEN (SETQ DIFF (LDIFFERENCE CS2CHARS CS1CHARS))
|
||||
(PRINTOUT T "2 but not 1:" 14 .PPV (SORT (LDIFFERENCE CS2CHARS CS1CHARS))
|
||||
T))
|
||||
(LIST CS1 CS2])
|
||||
|
||||
(SHOWBMS
|
||||
[LAMBDA (CHARSETINFOS) (* ; "Edited 30-Jun-2025 08:47 by rmk")
|
||||
(for CS in CHARSETINFOS do (ICS CS])
|
||||
|
||||
(SHOWCHARBITMAPS
|
||||
[LAMBDA (CODE CSINFOS CHARSET INCLUDEMEDLEYFONT CLOSEPREVIOUS)
|
||||
(* ; "Edited 6-Jul-2025 22:04 by rmk")
|
||||
(* ; "Edited 2-Jul-2025 11:48 by rmk")
|
||||
(* ; "Edited 20-Jun-2025 16:38 by rmk")
|
||||
|
||||
(* ;; "Shows the bitmap for CODE in each of the CSINFOS")
|
||||
|
||||
(* ;; "If we call the inspector directly, it asks for contents vs. fields, also a pain, and we still don't get our hands on the window.")
|
||||
|
||||
[SETQ CSINFOS (for CS inside CSINFOS collect (OR (DEBUGCHARSET CS CHARSET INCLUDEMEDLEYFONT)
|
||||
(ERROR CS "not found"]
|
||||
(CL:WHEN CLOSEPREVIOUS
|
||||
(for W in (OPENWINDOWS) when (EQ 'EDITBMREPAINTFN (WINDOWPROP W 'REPAINTFN))
|
||||
do (CLOSEW W)))
|
||||
(if (CHARCODEP CODE)
|
||||
then (for CS BM in CSINFOS do (SETQ BM (\GETCHARBITMAP.CSINFO CODE CS))
|
||||
(if (AND (IGREATERP (BITMAPWIDTH BM)
|
||||
0)
|
||||
(IGREATERP (BITMAPHEIGHT BM)
|
||||
0))
|
||||
then (EVAL.AS.PROCESS (LIST 'EDITBM BM))
|
||||
else "EMPTY BITMAP"))
|
||||
else (for CS in CSINFOS do (SHOWCSBITMAP CS])
|
||||
|
||||
(CANDS
|
||||
[LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 2-Jul-2025 11:47 by rmk")
|
||||
|
||||
(* ;; "Wraps comparing and showing, closes previous bitmap windows")
|
||||
|
||||
(LET ((CINFOS (CSCOMPARE CS1 CS2 CHARSET INCLUDEMEDLEYFONT)))
|
||||
(SHOWCHARBITMAPS NIL CINFOS CHARSET INCLUDEMEDLEYFONT T)
|
||||
CINFOS])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FONTSIZE
|
||||
[LAMBDA (FONT CHARSETS FILETOO NOERROR) (* ; "Edited 19-Jul-2025 16:42 by rmk")
|
||||
(SETQ FONT (FONTCREATE FONT NIL NIL NIL 'DISPLAY NOERROR))
|
||||
(CL:UNLESS CHARSETS
|
||||
(SETQ CHARSETS (for CS CSINFO BM from 0 to 255 when (SETQ CSINFO (\XGETCHARSETINFO FONT CS))
|
||||
unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CS)))
|
||||
(PRINTOUT T "Charsets: ")
|
||||
(for CS CSINFO inside CHARSETS sum (PRINTOUT T CS " ")
|
||||
(CSSIZE (\XGETCHARSETINFO FONT CS)
|
||||
T) finally (PRINTOUT T T])
|
||||
|
||||
(CSSIZE
|
||||
[LAMBDA (CSINFO INCLUDEBM) (* ; "Edited 19-Jul-2025 16:37 by rmk")
|
||||
|
||||
(* ;; "Returns")
|
||||
|
||||
(LET ((BLOCKSIZE (UNFOLD (IPLUS \MAXCHARSET 3)
|
||||
2))
|
||||
BM)
|
||||
(IPLUS (CL:IF (fetch (CHARSETINFO OFFSETS) of CSINFO)
|
||||
BLOCKSIZE
|
||||
0)
|
||||
(CL:IF (fetch (CHARSETINFO WIDTHS) of CSINFO)
|
||||
BLOCKSIZE
|
||||
0)
|
||||
(CL:IF (AND (NEQ (fetch (CHARSETINFO WIDTHS) of CSINFO)
|
||||
(fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO))
|
||||
(fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO))
|
||||
BLOCKSIZE
|
||||
0)
|
||||
(CL:IF (fetch (CHARSETINFO YWIDTHS) of CSINFO)
|
||||
BLOCKSIZE
|
||||
0)
|
||||
(CL:IF (ARRAYP (fetch (CHARSETINFO LEFTKERN) of CSINFO))
|
||||
(UNFOLD (ARRAYSIZE (fetch (CHARSETINFO LEFTKERN) of CSINFO))
|
||||
4)
|
||||
0)
|
||||
(CL:IF (AND INCLUDEBM (SETQ BM (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)))
|
||||
(IQUOTIENT (ITIMES (BITMAPWIDTH BM)
|
||||
(BITMAPHEIGHT BM))
|
||||
8)
|
||||
0)])
|
||||
|
||||
(CSBMSIZE
|
||||
[LAMBDA (FONT CHARSETS FILETOO NOERROR) (* ; "Edited 19-Jul-2025 16:14 by rmk")
|
||||
(* ; "Edited 17-Jul-2025 13:23 by rmk")
|
||||
|
||||
(* ;; "Returns the number of bytes in the CHARSET bitmap for FONT, what's in core unless FILETOO")
|
||||
|
||||
(if (SETQ FONT (FONTCREATE FONT NIL NIL NIL 'DISPLAY NOERROR))
|
||||
then (CL:UNLESS CHARSETS
|
||||
(SETQ CHARSETS (for CS CSINFO BM from 0 to 255 when (SETQ CSINFO (\XGETCHARSETINFO
|
||||
FONT CS))
|
||||
unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CS)))
|
||||
(PRINTOUT T "Charsets: ")
|
||||
(for CS CSINFO BM inside CHARSETS sum (PRINTOUT T CS " ")
|
||||
(SETQ BM (fetch (CHARSETINFO CHARSETBITMAP)
|
||||
of (\XGETCHARSETINFO FONT CS)))
|
||||
(IQUOTIENT (ITIMES (BITMAPWIDTH BM)
|
||||
(BITMAPHEIGHT BM))
|
||||
8) finally (PRINTOUT T T))
|
||||
else 0])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (818 15839 (DEBUGCHARSET 828 . 4007) (IBM 4009 . 4717) (ICS 4719 . 6013) (SHOWCACHE 6015
|
||||
. 6362) (SHOWCSBITMAP 6364 . 7478) (EQCSBM 7480 . 8366) (EQCHARBM 8368 . 9129) (CHARSETCHARS 9131 .
|
||||
9797) (CHARBMDIFFS 9799 . 10675) (SHOWCSCHAR 10677 . 11112) (CSCOMPARE 11114 . 13706) (SHOWBMS 13708
|
||||
. 13886) (SHOWCHARBITMAPS 13888 . 15479) (CANDS 15481 . 15837)) (15840 19322 (FONTSIZE 15850 . 16535)
|
||||
(CSSIZE 16537 . 17946) (CSBMSIZE 17948 . 19320)))))
|
||||
STOP
|
||||
BIN
internal/FONT-DEBUG.LCOM
Normal file
BIN
internal/FONT-DEBUG.LCOM
Normal file
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Apr-2025 05:14:27" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;2 4662
|
||||
(FILECREATED "13-Jul-2025 11:41:03" {WMEDLEY}<internal>loadups>LOADUP-FULL.;28 5184
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LOADFULLFONTS)
|
||||
|
||||
:PREVIOUS-DATE "31-Jul-2023 18:28:53" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;1
|
||||
)
|
||||
:PREVIOUS-DATE "30-Jun-2025 00:04:34" {WMEDLEY}<internal>loadups>LOADUP-FULL.;27)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-FULLCOMS)
|
||||
@@ -17,32 +16,37 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADFULLFONTS
|
||||
[LAMBDA NIL (* ; "Edited 23-Apr-2025 05:13 by lmm")
|
||||
[LAMBDA NIL (* ; "Edited 13-Jul-2025 11:40 by rmk")
|
||||
(* ; "Edited 30-Jun-2025 00:04 by rmk")
|
||||
(* ; "Edited 20-Jun-2025 11:16 by rmk")
|
||||
(* ; "Edited 16-Jun-2025 15:34 by rmk")
|
||||
(* ; "Edited 23-Apr-2025 05:13 by lmm")
|
||||
(* ; "Edited 13-Feb-2021 22:51 by larry")
|
||||
|
||||
(* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")
|
||||
|
||||
(PRINTOUT T "Loading FULL fonts..." T)
|
||||
(SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT STRIKE))
|
||||
(SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT)
|
||||
(RESETVARS ((MISSINGDISPLAYFONTCOERCIONS NIL)
|
||||
(MISSINGCHARSETDISPLAYFONTCOERCIONS NIL)) (* ;
|
||||
"Don't let the font loader substitute just because a server went catatonic on us")
|
||||
(for FAMILY in '(CLASSIC MODERN TERMINAL)
|
||||
do (PRINTOUT T " Loading " FAMILY " ")
|
||||
[for SIZE in '(8 10 12)
|
||||
do (PRINTOUT T SIZE " ")
|
||||
(for FACE in '(MRR BRR MIR)
|
||||
do (for CSET in '(0 33 34 35 238 239 241)
|
||||
do (NLSETQ (FONTCREATE FAMILY SIZE FACE NIL 'DISPLAY NIL CSET]
|
||||
(PRINTOUT T T))
|
||||
(PRINTOUT T " Loading postscript fonts" T)
|
||||
(for F in (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
|
||||
">c0>*.PSCFONT")) do (PSCFONT.READFONT F))
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(* ;; "Previous code reset the coercion variables to NIL, which would have resulted in glyph-incomplete charsets. With Medley-formatted fonts, the completions have already been installed in the files and there is no need to deal with those variables.")
|
||||
|
||||
(for FAMILY in '(CLASSIC MODERN TERMINAL)
|
||||
do (PRINTOUT T " Loading " FAMILY " ")
|
||||
[for SIZE in '(8 10 12)
|
||||
do (PRINTOUT T SIZE " ")
|
||||
(for FACE in '(MRR BRR MIR)
|
||||
do (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL 0)
|
||||
(for CSET in '(33 34 35 238 239 241)
|
||||
do (NLSETQ (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL CSET]
|
||||
(PRINTOUT T T))
|
||||
(PRINTOUT T " Loading postscript fonts" T)
|
||||
(for F in (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
|
||||
">c0>*.PSCFONT")) do (PSCFONT.READFONT F))
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(LOADUP-FULL
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 18-Jan-2023 16:22 by FGH")
|
||||
[LAMBDA (DRIBBLEFILE) (* ; "Edited 21-Jun-2025 23:33 by rmk")
|
||||
(* ; "Edited 18-Jan-2023 16:22 by FGH")
|
||||
(* ; "Edited 12-Aug-2022 11:17 by lmm")
|
||||
(* ; "Edited 14-Jul-2022 12:32 by rmk")
|
||||
(* ; "Edited 12-Jul-2022 21:57 by rmk")
|
||||
@@ -67,6 +71,7 @@
|
||||
" while connected to "
|
||||
(DIRECTORYNAME T)
|
||||
T T)
|
||||
(LOADUP '(MULTI-ALIST)) (* ; "For FONTSAVAILABLE lookup")
|
||||
(LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT")
|
||||
(LOADFULLFONTS)
|
||||
(LISTPUT IDLE.PROFILE 'TIMEOUT 0)
|
||||
@@ -89,5 +94,5 @@
|
||||
|
||||
(FIXMETA)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (493 4624 (LOADFULLFONTS 503 . 2059) (LOADUP-FULL 2061 . 4374) (FIXMETA 4376 . 4622)))))
|
||||
(FILEMAP (NIL (458 5146 (LOADFULLFONTS 468 . 2373) (LOADUP-FULL 2375 . 4896) (FIXMETA 4898 . 5144)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "21-Mar-2024 10:56:13" |{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;4| 5586
|
||||
(FILECREATED "15-Jun-2025 14:39:57" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;20| 6425
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY |rmk|
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-LISP)
|
||||
|
||||
:PREVIOUS-DATE "14-Mar-2024 12:16:33"
|
||||
|{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;3|)
|
||||
:PREVIOUS-DATE "24-May-2025 10:20:14" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;14|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||
@@ -20,7 +19,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-LISP
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 21-Mar-2024 10:55 by lmm")
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 15-Jun-2025 14:39 by rmk")
|
||||
(* \; "Edited 24-May-2025 10:20 by rmk")
|
||||
(* \; "Edited 21-May-2025 09:25 by rmk")
|
||||
(* \; "Edited 5-May-2025 21:25 by rmk")
|
||||
(* \; "Edited 2-May-2025 22:12 by rmk")
|
||||
(* \; "Edited 21-Mar-2024 10:55 by lmm")
|
||||
(* \; "Edited 14-Mar-2024 12:16 by lmm")
|
||||
(* \; "Edited 26-Feb-2023 12:17 by lmm")
|
||||
(* \; "Edited 13-Jul-2022 14:09 by rmk")
|
||||
@@ -61,8 +65,8 @@
|
||||
|
||||
(LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS))
|
||||
(LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR))
|
||||
(LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN LOADFNS
|
||||
DMISC DIRECTORY SPELLFILE FILEPKG RESOURCE))
|
||||
(LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF SPELLFILE PRINTFN LOADFNS DMISC
|
||||
DIRECTORY SPELLFILE FILEPKG RESOURCE))
|
||||
|
||||
(* |;;| "needed for makesys")
|
||||
|
||||
@@ -79,9 +83,12 @@
|
||||
CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES))
|
||||
(LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT))
|
||||
(LOADUP '(ADDARITH))
|
||||
(LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW
|
||||
WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE
|
||||
CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
|
||||
|
||||
(* |;;| "Before the MEDLEYFONT implementation, FONTPROFILE came after NEWPRINTDEF above, but the loadup failed for undiagnosed reasons. After moving it around, it appears that it must come before MENU, because it creates thw WINDOWTITLEFONT, but after HLDISPLAY. Not yet known what the HLDISPLAY dependency is. ")
|
||||
|
||||
(LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU WINDOWOBJ
|
||||
WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT
|
||||
DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
|
||||
(LOADUP '(BREAK-AND-TRACE))
|
||||
(LOADUP '(FASDUMP XCL-COMPILER ADVISE))
|
||||
|
||||
@@ -131,5 +138,5 @@
|
||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (673 5380 (LOADUP-LISP 683 . 5378)))))
|
||||
(FILEMAP (NIL (640 6219 (LOADUP-LISP 650 . 6217)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user