Basic font files--see documentation
For the most part as described in docs/internal/FONTCODECHANGES and docs/internal/MEDLEYFONTFORMAT
This commit is contained in:
rmkaplan
@@ -1,23 +1,25 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2025 16:43:34" {WMEDLEY}<internal>FONT-DEBUG.;46 19345
|
||||
(FILECREATED " 2-Sep-2025 13:47:42" {WMEDLEY}<internal>FONT-DEBUG.;66 23502
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CSBMSIZE FONTSIZE CSSIZE EQCHARBM)
|
||||
(VARS FONT-DEBUGCOMS)
|
||||
:CHANGES-TO (FNS TRUEFONTCREATE)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2025 12:36:48" {WMEDLEY}<internal>FONT-DEBUG.;41)
|
||||
:PREVIOUS-DATE "29-Aug-2025 22:39:54" {WMEDLEY}<internal>FONT-DEBUG.;65)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONT-DEBUGCOMS)
|
||||
|
||||
(RPAQQ FONT-DEBUGCOMS (
|
||||
(* ;; "Little tools to help in debugging display fonts")
|
||||
(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)))
|
||||
(FNS DEBUGCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM EQCHARBM CHARSETCHARS CHARBMDIFFS
|
||||
SHOWCSCHAR CSCOMPARE SHOWBMS SHOWCHARBITMAPS CANDS TRUEFONTCREATE)
|
||||
(FNS FONTSIZE CSSIZE CSBMSIZE)
|
||||
(FNS FONTCOMPARE)
|
||||
(MACROS TRUEFONT)))
|
||||
|
||||
|
||||
|
||||
@@ -26,7 +28,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(DEBUGCHARSET
|
||||
[LAMBDA (FONTSPEC CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 9-Jul-2025 16:26 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 27-Aug-2025 17:19 by rmk")
|
||||
(* ; "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")
|
||||
@@ -43,46 +46,41 @@
|
||||
(CL:UNLESS INCLUDEMEDLEYFONT
|
||||
(RESETSAVE DISPLAYFONTEXTENSIONS (REMOVE 'MEDLEYDISPLAYFONT DISPLAYFONTEXTENSIONS)
|
||||
))
|
||||
[if (OR (LITATOM FONTSPEC)
|
||||
(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))
|
||||
(for FNS CSINFO (FI _ (FONTSPECFROMFILENAME 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))
|
||||
STRM 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])])
|
||||
else (\READCHARSET (\FONT.CHECKARGS FONTSPEC)
|
||||
CHARSET)))])
|
||||
|
||||
(IBM
|
||||
[LAMBDA (FONT CHARSET) (* ; "Edited 29-Jun-2025 17:05 by rmk")
|
||||
[LAMBDA (FONT CHARSET) (* ; "Edited 27-Aug-2025 17:29 by rmk")
|
||||
(* ; "Edited 25-Aug-2025 08:58 by rmk")
|
||||
(* ; "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).")
|
||||
|
||||
(SETQ CHARSET (CHARSET.DECODE CHARSET))
|
||||
(SHOWCSBITMAP (if (type? CHARSETINFO FONT)
|
||||
then FONT
|
||||
else (\XGETCHARSETINFO (SETQ FONT (FONTCREATE FONT))
|
||||
(OR CHARSET 0])
|
||||
elseif FONT
|
||||
then (\XGETCHARSETINFO (FONTCREATE FONT)
|
||||
(OR CHARSET 0])
|
||||
|
||||
(ICS
|
||||
[LAMBDA (FONT CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 7-Jul-2025 23:12 by rmk")
|
||||
@@ -114,7 +112,8 @@
|
||||
(DV \FONTEXISTS?-CACHE])
|
||||
|
||||
(SHOWCSBITMAP
|
||||
[LAMBDA (CSINFO) (* ; "Edited 29-Jun-2025 17:07 by rmk")
|
||||
[LAMBDA (CSINFO) (* ; "Edited 17-Aug-2025 12:36 by rmk")
|
||||
(* ; "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.")
|
||||
@@ -129,7 +128,7 @@
|
||||
(IGREATERP (BITMAPHEIGHT BM)
|
||||
0))
|
||||
then (EVAL.AS.PROCESS (LIST 'EDITBM BM))
|
||||
else "EMPTY BITMAP")
|
||||
else (PRINTOUT T "EMPTY BITMAP" T))
|
||||
CSINFO])
|
||||
|
||||
(EQCSBM
|
||||
@@ -277,11 +276,27 @@
|
||||
(LET ((CINFOS (CSCOMPARE CS1 CS2 CHARSET INCLUDEMEDLEYFONT)))
|
||||
(SHOWCHARBITMAPS NIL CINFOS CHARSET INCLUDEMEDLEYFONT T)
|
||||
CINFOS])
|
||||
|
||||
(TRUEFONTCREATE
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET)
|
||||
(* ; "Edited 2-Sep-2025 13:46 by rmk")
|
||||
(* ; "Edited 29-Aug-2025 22:38 by rmk")
|
||||
(* ; "Edited 17-Aug-2025 15:47 by rmk")
|
||||
(* ; "Edited 31-Jul-2025 10:10 by rmk")
|
||||
(* ; "Edited 25-Jul-2025 13:43 by rmk")
|
||||
|
||||
(* ;; "New font, no coercions, no MEDLEYFORMAT")
|
||||
|
||||
(LEGACYFONT (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FONTSIZE
|
||||
[LAMBDA (FONT CHARSETS FILETOO NOERROR) (* ; "Edited 19-Jul-2025 16:42 by rmk")
|
||||
[LAMBDA (FONT CHARSETS FILETOO NOERROR) (* ; "Edited 16-Aug-2025 23:34 by rmk")
|
||||
(* ; "Edited 19-Jul-2025 16:42 by rmk")
|
||||
|
||||
(* ;; "Estimates the amount of storage occupied by FONT")
|
||||
|
||||
(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))
|
||||
@@ -343,10 +358,72 @@
|
||||
8) finally (PRINTOUT T T))
|
||||
else 0])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FONTCOMPARE
|
||||
[LAMBDA (ARGS VIRGIN SHOWFONT) (* ; "Edited 5-Aug-2025 13:14 by rmk")
|
||||
|
||||
(* ;; "Prints a line of characters in different fonts, for shape/size comparison. Each argument is a list of the form (FONT CHAR1 CHAR2...) or (FONT CHAR1 - CHARN) (hyphen). Characters can be codes or names.")
|
||||
|
||||
(* ;; "If CHARS are not specfied, uses the chars from the previous arg.")
|
||||
|
||||
(RESETLST
|
||||
(RESETSAVE (DSPFONT NIL T))
|
||||
(CL:WHEN VIRGIN
|
||||
(RESETSAVE \FONTSINCORE NIL)
|
||||
(RESETSAVE \DISPLAYCHARSETCOERCIONS NIL)
|
||||
(RESETSAVE \DISPLAYFONTCOERCIONS NIL)
|
||||
(RESETSAVE \FONTEXISTS?-CACHE NIL)
|
||||
(RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT)))
|
||||
(TERPRI T)
|
||||
(for A CHARS FONT SIZEPOS in ARGS
|
||||
do (CL:WHEN (CADR A)
|
||||
(SETQ CHARS (CDR A))
|
||||
[SETQ CHARS (if (EQ '- (CADR CHARS))
|
||||
then (for C from (CL:IF (CHARCODEP (CAR CHARS))
|
||||
(CAR CHARS)
|
||||
(CHARCODE.DECODE (CAR CHARS)))
|
||||
to (CL:IF (CHARCODEP (CADDR CHARS))
|
||||
(CADDR CHARS)
|
||||
(CHARCODE.DECODE (CADDR CHARS))) collect C)
|
||||
else (for C in CHARS collect (CL:IF (CHARCODEP C)
|
||||
C
|
||||
(CHARCODE.DECODE C))])
|
||||
(SETQ FONT (FONTCREATE (CAR A)))
|
||||
(if SHOWFONT
|
||||
then (SETQ SIZEPOS (IDIFFERENCE (STRPOS "-" FONT)
|
||||
2))
|
||||
(PRINTOUT T .FONT '(GACHA 8)
|
||||
" ["
|
||||
(SUBSTRING FONT 2 3)
|
||||
(SUBSTRING FONT SIZEPOS (ADD1 SIZEPOS))
|
||||
"]")
|
||||
else (PRINTOUT T .FONT '(GACHA 8)
|
||||
"/"))
|
||||
(DSPFONT FONT T)
|
||||
(for C in CHARS do (PRIN1 (CHARACTER C)
|
||||
T)))
|
||||
(TERPRI T))])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS TRUEFONT MACRO ((FORM) (* ;
|
||||
"Execute FORM in a non-medleyfont displayfont environment")
|
||||
(RESETVARS (\FONTSINCORE \FONTEXISTS?-CACHE DISPLAYFONTCOERCIONS
|
||||
DISPLAYCHARCOERCIONS (DISPLAYFONTEXTENSIONS '(DISPLAYFONT
|
||||
))
|
||||
(DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>")
|
||||
)
|
||||
(DISPLAYCHARSETFNS (REMOVE (ASSOC 'MEDLEYFONT
|
||||
DISPLAYCHARSETFNS)
|
||||
DISPLAYCHARSETFNS)))
|
||||
(RETURN FORM))))
|
||||
)
|
||||
(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)))))
|
||||
(FILEMAP (NIL (774 16422 (DEBUGCHARSET 784 . 3405) (IBM 3407 . 4405) (ICS 4407 . 5701) (SHOWCACHE 5703
|
||||
. 6050) (SHOWCSBITMAP 6052 . 7290) (EQCSBM 7292 . 8178) (EQCHARBM 8180 . 8941) (CHARSETCHARS 8943 .
|
||||
9609) (CHARBMDIFFS 9611 . 10487) (SHOWCSCHAR 10489 . 10924) (CSCOMPARE 10926 . 13518) (SHOWBMS 13520
|
||||
. 13698) (SHOWCHARBITMAPS 13700 . 15291) (CANDS 15293 . 15649) (TRUEFONTCREATE 15651 . 16420)) (16423
|
||||
20082 (FONTSIZE 16433 . 17295) (CSSIZE 17297 . 18706) (CSBMSIZE 18708 . 20080)) (20083 22490 (
|
||||
FONTCOMPARE 20093 . 22488)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user