1
0
mirror of synced 2026-05-02 14:31:05 +00:00

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
2025-08-13 09:59:37 -07:00
committed by GitHub
parent 9c93b27d79
commit a9618e4aaf
55 changed files with 5051 additions and 4016 deletions

View File

@@ -1,19 +1,18 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Apr-2024 09:49:11" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;5 9232
(FILECREATED "15-Jul-2025 10:25:11" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;7 7757
:EDIT-BY rmk
:CHANGES-TO (FNS NSDISPLAYSIZE)
:CHANGES-TO (FNS PURGENSFONTS)
:PREVIOUS-DATE " 8-Apr-2024 11:48:01" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;4)
:PREVIOUS-DATE " 9-Jun-2025 19:52:26" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;6)
(PRETTYCOMPRINT NSDISPLAYSIZESCOMS)
(RPAQQ NSDISPLAYSIZESCOMS
[(FNS NSDISPLAYSIZE NS\FONTFILENAME NS\FONTFILENAME.OLD PURGENSFONTS)
(ADDVARS (NSFONTFAMILIES CLASSIC MODERN TERMINAL OPTIMA TITAN))
(INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700)))
[COMS (* ;
 "VirtualKeyboard font needs adjusting so that real Classic 12 still appears")
@@ -90,44 +89,19 @@
FACE EXTENSION CHARACTERSET])
(PURGENSFONTS
[LAMBDA (TYPES) (* ; "Edited 14-Sep-96 09:27 by rmk:")
(* ; "Edited 14-Dec-87 14:53 by bvm:")
(/SETTOPVAL
'\FONTSINCORE
(FOR ENTRY IN \FONTSINCORE BIND BADTYPES TMP
COLLECT
(SETQ BADTYPES (IF (AND (MEMB (CAR ENTRY)
NSFONTFAMILIES)
(OR (NULL TYPES)
(EQMEMB 'NS TYPES)))
THEN (CONS 'DISPLAY TYPES)
ELSE (MKLIST TYPES)))
(CONS
(CAR ENTRY)
(FOR SIZES IN (CDR ENTRY)
WHEN [SETQ TMP
(IF (AND (NULL TYPES)
(> (CAR SIZES)
12))
THEN (* ;
 "Only have to get rid of sizes smaller than 14")
(CDR SIZES)
ELSE (FOR FACE IN (CDR SIZES)
WHEN (SETQ TMP
(FOR ROT IN (CDR FACE)
WHEN (SETQ TMP (FOR DEV
IN (CDR ROT) COLLECT
DEV
UNLESS (MEMB (CAR DEV)
BADTYPES)))
COLLECT (CONS (CAR ROT)
TMP)))
COLLECT (CONS (CAR FACE)
TMP] COLLECT (CONS (CAR SIZES)
TMP])
)
[LAMBDA (TYPES) (* ; "Edited 15-Jul-2025 09:47 by rmk")
(* ; "Edited 14-Sep-96 09:27 by rmk:")
(* ; "Edited 14-Dec-87 14:53 by bvm:")
(ADDTOVAR NSFONTFAMILIES CLASSIC MODERN TERMINAL OPTIMA TITAN)
(* ;; "Removes current NS display fonts with sizes LEQ 12. No need to be undoable, cache entries will be recreated on demand.")
(DECLARE (GLOBALVARS \FONTSINCORE))
(MAPMULTI \FONTSINCORE (FUNCTION (LAMBDA (FM S FC R TAIL)
(CL:WHEN (AND (MEMB FM NSFONTFAMILIES)
(ILEQ S 12)
(EQ 'DISPLAY (CAR TAIL)))
(RPLACD TAIL])
)
(RPAQ? *SMALLSCREEN* (ILESSP SCREENWIDTH 700))
@@ -170,7 +144,7 @@
(VKBD.FIX.FONT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1522 7564 (NSDISPLAYSIZE 1532 . 4862) (NS\FONTFILENAME 4864 . 5105) (
NS\FONTFILENAME.OLD 5107 . 5356) (PURGENSFONTS 5358 . 7562)) (7776 8814 (VKBD.FIX.FONT 7786 . 8812))))
(FILEMAP (NIL (1449 6157 (NSDISPLAYSIZE 1459 . 4789) (NS\FONTFILENAME 4791 . 5032) (
NS\FONTFILENAME.OLD 5034 . 5283) (PURGENSFONTS 5285 . 6155)) (6301 7339 (VKBD.FIX.FONT 6311 . 7337))))
)
STOP