Rmk97 medleyfontfile format

internal/FONT-DEBUG

@@ -0,0 +1,166 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "29-Jun-2025 18:01:37" {WMEDLEY}<internal>FONT-DEBUG.;7
 8491   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS SHOWCSCHAR READCHARSET EQCSBM CHARSETCHARS CHARBMDIFFS SHOWCACHE IBM ICS 
+                       SHOWCSBITMAP)
+                  (VARS FONT-DEBUGCOMS)
+
+      :PREVIOUS-DATE "29-Jun-2025 17:17:56" {WMEDLEY}<internal>FONT-DEBUG.;1)
+
+
+(PRETTYCOMPRINT FONT-DEBUGCOMS)
+
+(RPAQQ FONT-DEBUGCOMS
 (
+                       (* ;; "Little tools to help in debugging display fonts")

+
+                       (FNS READCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM CHARSETCHARS 
+                            CHARBMDIFFS SHOWCSCHAR)))
+
+
+
+(* ;; "Little tools to help in debugging display fonts")

+
+(DEFINEQ
+
+(READCHARSET

+  [LAMBDA (FONTSPEC CHARSET NOTMEDLEYFONT)
                   (* ; "Edited 29-Jun-2025 17:56 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.")

+
+    (* ;; 
+
    "CHARSET doesn't make sense if FONTSPEC is a filename, we don't call FONTFILES in that case")

+
+    (CL:UNLESS CHARSET (SETQ CHARSET 0))
+    (if
 (type?
 CHARSETINFO FONTSPEC)
+        then
 FONTSPEC
+      else
 (RESETLST
+               (CL:WHEN NOTMEDLEYFONT
+                   (RESETSAVE DISPLAYFONTEXTENSIONS (REMOVE 'MEDLEYDISPLAYFONT DISPLAYFONTEXTENSIONS)
+                          ))
+               (if
 (OR (LITATOM FONTSPEC)
+                       (STRINGP FONTSPEC))
+                   then
 (LET (STRM FI CPOS PPOS)
+                             [RESETSAVE (SETQ STRM (OPENSTREAM FONTSPEC 'INPUT))
+                                    `(PROGN (CLOSEF? OLDVALUE]
+                             (SETQ FI (\FONTINFOFROMFILENAME FONTSPEC 'DISPLAY))
+                             (for
 FNS CSINFO in
 DISPLAYCHARSETFNS
+                                do
 (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
+                                                                STRM)))
+                                       (SETQ CSINFO (APPLY* (CADDR FNS)
+                                                           STRM
+                                                           (CAR FI)
+                                                           (CADR FI)
+                                                           (CADDR FI)
+                                                           0
+                                                           'DISPLAY CHARSET))
+                                       (PUTMULTI (fetch
 (CHARSETINFO CSINFOPROPS) of
 CSINFO)
+                                              'FILE
+                                              (PSEUDOFILENAME FONTSPEC))
+                                       (RETURN CSINFO))
+                                   (CLOSEF? STRM)))
+                 else
 (CL:UNLESS CHARSET (SETQ CHARSET 0))
+                      (CL:MULTIPLE-VALUE-BIND (FAMILY SIZE FACE ROTATION DEVICE)
+                             (\FONT.CHECKARGS FONTSPEC)
+                             (\READDISPLAYFONTFILE 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 NOTMEDLEYFONT)
                       (* ; "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 (READCHARSET
 FONT CHARSET NOTMEDLEYFONT)))
+         (if
 CSINFO
+             then
 (SHOWCSBITMAP
 CSINFO)
+                  (LIST (CADR (ASSOC 'FILE (fetch
 (CHARSETINFO CSINFOPROPS) of
 CSINFO)))
+                        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)
                                  (* ; "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 (READCHARSET
 CS1 CHARSET))
+    (SETQ CS2 (READCHARSET
 CS2 CHARSET))
+    (EQUALALL (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CS1)
+           (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CS2])
+
+(CHARSETCHARS

+  [LAMBDA (CSINFO CHARSET NOTMEDLEYFONT)
                     (* ; "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 (READCHARSET
 CSINFO CHARSET))
+    (for
 CODE from
 0 to
 \MAXTHINCHAR unless
 (SLUGCHARP.DISPLAY CODE CSINFO) collect
 CODE])
+
+(CHARBMDIFFS

+  [LAMBDA (CS1 CS2 CHARSET)
                                  (* ; "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 (READCHARSET
 CS1 CHARSET))
+    (SETQ CS2 (READCHARSET
 CS2 CHARSET))
+    (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)
                              (* ; "Edited 29-Jun-2025 18:01 by rmk")

+    (EDITBM (\GETCHARBITMAP.CSINFO CODE (READCHARSET
 CSINFO CHARSET])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (789 8468 (READCHARSET 799 . 3503) (IBM 3505 . 4213) (ICS 4215 . 5115) (SHOWCACHE 5117
+ . 5464) (SHOWCSBITMAP 5466 . 6580) (EQCSBM 6582 . 7213) (CHARSETCHARS 7215 . 7644) (CHARBMDIFFS 7646
+ . 8266) (SHOWCSCHAR 8268 . 8466)))))
+STOP